diff --git a/README.md b/README.md new file mode 100644 index 0000000..4641a7f --- /dev/null +++ b/README.md @@ -0,0 +1,17 @@ +# Deprecated + +This repository has been deprecated in favour of https://github.com/openmethane/CMAQ, +which has includes many of the same changes, but has a clearer lineage to official +CMAQ v5.0.2. + +# CMAQ v5.0.2 + +US EPA Community Multiscale Air Quality Model (CMAQ) Website: https://www.epa.gov/cmaq + +## Open Methane fork + +This repository is a version of https://github.com/USEPA/CMAQ/tree/5.0.2 which +has been modified specifically to work for Open Methane. + +If you are seeking to start a new project based on CMAQ, you should use the +official versions provided by the US EPA. diff --git a/license.md b/license.md new file mode 100644 index 0000000..94626da --- /dev/null +++ b/license.md @@ -0,0 +1,9 @@ +# MIT License + +Copyright (c) 2019 U.S. Federal Government (in countries where recognized) + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/models/BCON/prof_data/CH4only/bc_profile_CH4only.dat b/models/BCON/prof_data/CH4only/bc_profile_CH4only.dat new file mode 100755 index 0000000..9d4c6a9 --- /dev/null +++ b/models/BCON/prof_data/CH4only/bc_profile_CH4only.dat @@ -0,0 +1,13 @@ + CB05 gas mechanism with AERO5 species and toxics + bcon profile data converted from RADM2 gas mechanism species + layers and defined sigma levels are listed below. + 6 1 1.00 0.98 0.93 0.84 0.60 0.30 0.00 + 2011-08-10 + North +"CH4 " 1.8 1.8 1.8 1.8 1.8 1.8 + East +"CH4 " 1.8 1.8 1.8 1.8 1.8 1.8 + South +"CH4 " 1.8 1.8 1.8 1.8 1.8 1.8 + West +"CH4 " 1.8 1.8 1.8 1.8 1.8 1.8 diff --git a/models/CCTM/MECHS/CH4only/AE_CH4only.csv b/models/CCTM/MECHS/CH4only/AE_CH4only.csv new file mode 100755 index 0000000..a48d7df --- /dev/null +++ b/models/CCTM/MECHS/CH4only/AE_CH4only.csv @@ -0,0 +1 @@ +SPC,MOLWT,EMIS_SUR,EMIS_FAC,DEPV_SUR,DEPV_FAC,SCAV_SUR,SCAV_FAC,ICBC_SUR,ICBC_FAC,A2AQ_SUR,TRNS,DDEP,WDEP,CONC diff --git a/models/CCTM/MECHS/CH4only/AE_CH4only.nml b/models/CCTM/MECHS/CH4only/AE_CH4only.nml new file mode 100755 index 0000000..a54c926 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/AE_CH4only.nml @@ -0,0 +1,13 @@ +! RCS file, release, date & time of last delta, author, state, [and locker] +! $Header: /project/yoj/arc/MECHS/src/cb05cl_ae5_aq/AE_cb05cl_ae5_aq.nml,v 1.1 2011/12/09 11:49:56 yoj Exp $ + +&AE_nml + +n_surr1 = 4, +n_surr2 = 1, +n_ctrl = 4, + +TYPE_HEADER = +'SPC:MOLWT:EMIS_SUR:EMIS_FAC:DEPV_SUR:DEPV_FAC:SCAV_SUR:SCAV_FAC:ICBC_SUR:ICBC_FAC:A2AQ_SUR:TRNS:DDEP:WDEP:CONC', +TYPE_MATRIX = +/ diff --git a/models/CCTM/MECHS/CH4only/CSQY_DATA_CH4only b/models/CCTM/MECHS/CH4only/CSQY_DATA_CH4only new file mode 100755 index 0000000..e731676 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/CSQY_DATA_CH4only @@ -0,0 +1,553 @@ +Table for Mechanism = CB05CL_AE5_AQ +NPHOTAB = 23 +!Individual rates listed below: +NO2_SAPRC99 +O3_O3P_IUPAC04 +O3_O1D_IUPAC04 +NO3NO2_SAPRC99 +NO3NO_SAPRC99 +HONO_IUPAC04 +H2O2_SAPRC99 +HO2NO2_IUPAC04 +HNO3_IUPAC04 +N2O5_IUPAC04 +NTR_IUPAC04 +COOH_SAPRC99 +HCHO_R_SAPRC99 +HCHO_M_SAPRC99 +CCHO_R_SAPRC99 +PAN_IUPAC04 +PACD_CB05 +C2CHO_SAPRC99 +MGLY_IUPAC04 +ACROLEIN_SAPRC99 +CL2_IUPAC04 +HOCL_IUPAC04 +FMCL_IUPAC04 +NTEMP = 6 +! I TEMP( I ) K + 1 210.00 + 2 230.00 + 3 250.00 + 4 270.00 + 5 290.00 + 6 310.00 +! Cloud properties and aerosol refractive indices are weighted bin averages. +! The former is based on HU & Stamnes (1993), An accurate parameterization of +! the radiative properties of water clouds suitable for use in climate models, +! J. of Climate, vol. 6, pp. 728-742. The values were calculated with an +! equivalent radius of 10 micrometers. +! Note: Cloud extinction/LWC is in [1/m] over [g/m **3] where LWC is in g/m**3 +! +N_INLINE_BAND = 7 +! I, START_WL_BIN(nm), EFFECT_WL_BIN_(nm), END_WL_BIN_(nm), solar_photons_(cm-2*s-1), CLD_EXT/LWC_(m2/g), CLD_ASYM_FACT, CLD_COALBEDO, + 1, 291.000, 294.590, 298.300, 5.8828E+14, 0.154, 0.868, 6.9921E-06, + 2, 298.300, 303.151, 307.500, 7.6354E+14, 0.155, 0.869, 6.4844E-06, + 3, 307.500, 310.007, 312.500, 5.0412E+14, 0.156, 0.869, 6.0792E-06, + 4, 312.500, 316.434, 320.300, 8.9628E+14, 0.156, 0.869, 5.6397E-06, + 5, 320.300, 333.076, 345.000, 3.8537E+15, 0.156, 0.868, 4.2764E-06, + 6, 345.000, 381.997, 412.500, 1.5457E+16, 0.155, 0.866, 1.4743E-06, + 7, 412.500, 607.723, 850.000, 2.1307E+17, 0.157, 0.862, 6.7391E-06, +!... CS = absorption cross sections averaged over UCI Solar Flux +!... QY = quantum yields averaged over UCI Solar Flux +!... EQY = eCS*eQY/CS averaged over Solar Flux and 77 bins in UCI Model +!PHOTAB QUANTITY TEMP WBIN( 1) WBIN( 2) WBIN( 3) WBIN( 4) WBIN( 5) WBIN( 6) WBIN( 7) +NO2_SAPRC99 CS 210.000 1.079359E-19 1.478273E-19 1.860793E-19 2.249056E-19 3.335557E-19 5.492276E-19 1.146035E-20 +NO2_SAPRC99 EQY 210.000 1.000000E+00 1.000000E+00 9.986201E-01 9.907553E-01 9.900000E-01 7.779881E-01 3.503697E-02 +NO2_SAPRC99 CS 230.000 1.079359E-19 1.478273E-19 1.860793E-19 2.249056E-19 3.335557E-19 5.492276E-19 1.146035E-20 +NO2_SAPRC99 EQY 230.000 1.000000E+00 1.000000E+00 9.986201E-01 9.907553E-01 9.900000E-01 7.779881E-01 3.503697E-02 +NO2_SAPRC99 CS 250.000 1.079359E-19 1.478273E-19 1.860793E-19 2.249056E-19 3.335557E-19 5.492276E-19 1.146035E-20 +NO2_SAPRC99 EQY 250.000 1.000000E+00 1.000000E+00 9.986201E-01 9.907553E-01 9.900000E-01 7.779881E-01 3.503697E-02 +NO2_SAPRC99 CS 270.000 1.079359E-19 1.478273E-19 1.860793E-19 2.249056E-19 3.335557E-19 5.492276E-19 1.146035E-20 +NO2_SAPRC99 EQY 270.000 1.000000E+00 1.000000E+00 9.986201E-01 9.907553E-01 9.900000E-01 7.779881E-01 3.503697E-02 +NO2_SAPRC99 CS 290.000 1.079359E-19 1.478273E-19 1.860793E-19 2.249056E-19 3.335557E-19 5.492276E-19 1.146035E-20 +NO2_SAPRC99 EQY 290.000 1.000000E+00 1.000000E+00 9.986201E-01 9.907553E-01 9.900000E-01 7.779881E-01 3.503697E-02 +NO2_SAPRC99 CS 310.000 1.079359E-19 1.478273E-19 1.860793E-19 2.249056E-19 3.335557E-19 5.492276E-19 1.146035E-20 +NO2_SAPRC99 EQY 310.000 1.000000E+00 1.000000E+00 9.986201E-01 9.907553E-01 9.900000E-01 7.779881E-01 3.503697E-02 +O3_O3P_IUPAC04 CS 210.000 6.113743E-19 2.263004E-19 8.354117E-20 3.417408E-20 3.688351E-21 4.086261E-23 1.663175E-21 +O3_O3P_IUPAC04 EQY 210.000 1.000000E-01 1.000000E-01 6.003182E-01 9.089605E-01 9.200000E-01 1.000000E+00 1.000000E+00 +O3_O3P_IUPAC04 CS 230.000 6.205283E-19 2.311890E-19 8.611383E-20 3.563522E-20 3.944029E-21 4.086261E-23 1.663175E-21 +O3_O3P_IUPAC04 EQY 230.000 1.000000E-01 1.000000E-01 5.834519E-01 8.951057E-01 9.200000E-01 1.000000E+00 1.000000E+00 +O3_O3P_IUPAC04 CS 250.000 6.357850E-19 2.393366E-19 9.040160E-20 3.807045E-20 4.370161E-21 4.086261E-23 1.663175E-21 +O3_O3P_IUPAC04 EQY 250.000 1.000000E-01 1.000000E-01 5.614076E-01 8.729967E-01 9.200000E-01 1.000000E+00 1.000000E+00 +O3_O3P_IUPAC04 CS 270.000 6.510416E-19 2.474842E-19 9.468937E-20 4.050569E-20 4.796293E-21 4.086261E-23 1.663175E-21 +O3_O3P_IUPAC04 EQY 270.000 1.000000E-01 1.000000E-01 5.326853E-01 8.401006E-01 9.200000E-01 1.000000E+00 1.000000E+00 +O3_O3P_IUPAC04 CS 290.000 6.662983E-19 2.556319E-19 9.897714E-20 4.294093E-20 5.222424E-21 4.086261E-23 1.663175E-21 +O3_O3P_IUPAC04 EQY 290.000 1.000000E-01 1.000000E-01 4.957221E-01 7.937940E-01 9.200000E-01 1.000000E+00 1.000000E+00 +O3_O3P_IUPAC04 CS 310.000 6.685868E-19 2.568540E-19 9.962031E-20 4.330621E-20 5.286344E-21 4.086261E-23 1.663175E-21 +O3_O3P_IUPAC04 EQY 310.000 1.000000E-01 1.000000E-01 4.489501E-01 7.314585E-01 9.200000E-01 1.000000E+00 1.000000E+00 +O3_O1D_IUPAC04 CS 210.000 6.113743E-19 2.263004E-19 8.354117E-20 3.417408E-20 3.688351E-21 4.086261E-23 1.663175E-21 +O3_O1D_IUPAC04 EQY 210.000 9.000000E-01 9.000000E-01 3.996818E-01 9.103949E-02 8.000000E-02 0.000000E+00 0.000000E+00 +O3_O1D_IUPAC04 CS 230.000 6.205283E-19 2.311890E-19 8.611383E-20 3.563522E-20 3.944029E-21 4.086261E-23 1.663175E-21 +O3_O1D_IUPAC04 EQY 230.000 9.000000E-01 9.000000E-01 4.165481E-01 1.048944E-01 8.000000E-02 0.000000E+00 0.000000E+00 +O3_O1D_IUPAC04 CS 250.000 6.357850E-19 2.393366E-19 9.040160E-20 3.807045E-20 4.370161E-21 4.086261E-23 1.663175E-21 +O3_O1D_IUPAC04 EQY 250.000 9.000000E-01 9.000000E-01 4.385925E-01 1.270033E-01 8.000000E-02 0.000000E+00 0.000000E+00 +O3_O1D_IUPAC04 CS 270.000 6.510416E-19 2.474842E-19 9.468937E-20 4.050569E-20 4.796293E-21 4.086261E-23 1.663175E-21 +O3_O1D_IUPAC04 EQY 270.000 9.000000E-01 9.000000E-01 4.673147E-01 1.598994E-01 8.000000E-02 0.000000E+00 0.000000E+00 +O3_O1D_IUPAC04 CS 290.000 6.662983E-19 2.556319E-19 9.897714E-20 4.294093E-20 5.222424E-21 4.086261E-23 1.663175E-21 +O3_O1D_IUPAC04 EQY 290.000 9.000000E-01 9.000000E-01 5.042779E-01 2.062059E-01 8.000000E-02 0.000000E+00 0.000000E+00 +O3_O1D_IUPAC04 CS 310.000 6.685868E-19 2.568540E-19 9.962031E-20 4.330621E-20 5.286344E-21 4.086261E-23 1.663175E-21 +O3_O1D_IUPAC04 EQY 310.000 9.000000E-01 9.000000E-01 5.510499E-01 2.685415E-01 8.000000E-02 0.000000E+00 0.000000E+00 +NO3NO2_SAPRC99 CS 210.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO2_SAPRC99 EQY 210.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.000000E+00 6.710774E-01 +NO3NO2_SAPRC99 CS 230.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO2_SAPRC99 EQY 230.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.000000E+00 6.710774E-01 +NO3NO2_SAPRC99 CS 250.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO2_SAPRC99 EQY 250.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.000000E+00 6.710774E-01 +NO3NO2_SAPRC99 CS 270.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO2_SAPRC99 EQY 270.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.000000E+00 6.710774E-01 +NO3NO2_SAPRC99 CS 290.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO2_SAPRC99 EQY 290.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.000000E+00 6.710774E-01 +NO3NO2_SAPRC99 CS 310.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO2_SAPRC99 EQY 310.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 1.000000E+00 6.710774E-01 +NO3NO_SAPRC99 CS 210.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO_SAPRC99 EQY 210.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.208156E-02 +NO3NO_SAPRC99 CS 230.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO_SAPRC99 EQY 230.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.208156E-02 +NO3NO_SAPRC99 CS 250.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO_SAPRC99 EQY 250.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.208156E-02 +NO3NO_SAPRC99 CS 270.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO_SAPRC99 EQY 270.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.208156E-02 +NO3NO_SAPRC99 CS 290.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO_SAPRC99 EQY 290.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.208156E-02 +NO3NO_SAPRC99 CS 310.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 4.263211E-21 1.133738E-18 +NO3NO_SAPRC99 EQY 310.000 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 7.208156E-02 +HONO_IUPAC04 CS 210.000 0.000000E+00 4.780298E-21 1.602461E-20 3.132021E-20 9.264939E-20 7.356083E-20 0.000000E+00 +HONO_IUPAC04 EQY 210.000 0.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HONO_IUPAC04 CS 230.000 0.000000E+00 4.780298E-21 1.602461E-20 3.132021E-20 9.264939E-20 7.356083E-20 0.000000E+00 +HONO_IUPAC04 EQY 230.000 0.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HONO_IUPAC04 CS 250.000 0.000000E+00 4.780298E-21 1.602461E-20 3.132021E-20 9.264939E-20 7.356083E-20 0.000000E+00 +HONO_IUPAC04 EQY 250.000 0.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HONO_IUPAC04 CS 270.000 0.000000E+00 4.780298E-21 1.602461E-20 3.132021E-20 9.264939E-20 7.356083E-20 0.000000E+00 +HONO_IUPAC04 EQY 270.000 0.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HONO_IUPAC04 CS 290.000 0.000000E+00 4.780298E-21 1.602461E-20 3.132021E-20 9.264939E-20 7.356083E-20 0.000000E+00 +HONO_IUPAC04 EQY 290.000 0.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HONO_IUPAC04 CS 310.000 0.000000E+00 4.780298E-21 1.602461E-20 3.132021E-20 9.264939E-20 7.356083E-20 0.000000E+00 +HONO_IUPAC04 EQY 310.000 0.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +H2O2_SAPRC99 CS 210.000 8.427638E-21 5.088354E-21 3.292464E-21 2.152367E-21 8.185520E-22 3.606273E-23 0.000000E+00 +H2O2_SAPRC99 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +H2O2_SAPRC99 CS 230.000 8.549619E-21 5.182940E-21 3.368303E-21 2.213329E-21 8.507748E-22 3.606273E-23 0.000000E+00 +H2O2_SAPRC99 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +H2O2_SAPRC99 CS 250.000 8.714329E-21 5.310657E-21 3.470708E-21 2.295645E-21 8.942847E-22 3.606273E-23 0.000000E+00 +H2O2_SAPRC99 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +H2O2_SAPRC99 CS 270.000 8.923660E-21 5.472973E-21 3.600854E-21 2.400261E-21 9.495816E-22 3.606273E-23 0.000000E+00 +H2O2_SAPRC99 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +H2O2_SAPRC99 CS 290.000 9.177483E-21 5.669789E-21 3.758663E-21 2.527113E-21 1.016632E-21 3.606273E-23 0.000000E+00 +H2O2_SAPRC99 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +H2O2_SAPRC99 CS 310.000 9.474017E-21 5.899723E-21 3.943025E-21 2.675310E-21 1.094965E-21 3.606273E-23 0.000000E+00 +H2O2_SAPRC99 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HO2NO2_IUPAC04 CS 210.000 2.296186E-20 9.148771E-21 4.020221E-21 1.988848E-21 4.069196E-22 2.316807E-24 0.000000E+00 +HO2NO2_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +HO2NO2_IUPAC04 CS 230.000 2.343780E-20 9.481832E-21 4.239498E-21 2.133670E-21 4.616758E-22 3.211597E-24 0.000000E+00 +HO2NO2_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +HO2NO2_IUPAC04 CS 250.000 2.412330E-20 9.961530E-21 4.555314E-21 2.342253E-21 5.405393E-22 4.500329E-24 0.000000E+00 +HO2NO2_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +HO2NO2_IUPAC04 CS 270.000 2.504393E-20 1.060578E-20 4.979464E-21 2.622385E-21 6.464553E-22 6.231135E-24 0.000000E+00 +HO2NO2_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +HO2NO2_IUPAC04 CS 290.000 2.621512E-20 1.142536E-20 5.519046E-21 2.978755E-21 7.811962E-22 8.432978E-24 0.000000E+00 +HO2NO2_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +HO2NO2_IUPAC04 CS 310.000 2.764261E-20 1.242429E-20 6.176713E-21 3.413115E-21 9.454243E-22 1.111668E-23 0.000000E+00 +HO2NO2_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +HNO3_IUPAC04 CS 210.000 3.432040E-21 1.409886E-21 5.677406E-22 2.170392E-22 2.007828E-23 1.897096E-25 0.000000E+00 +HNO3_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HNO3_IUPAC04 CS 230.000 3.615218E-21 1.510034E-21 6.185092E-22 2.424359E-22 2.427861E-23 1.916848E-25 0.000000E+00 +HNO3_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HNO3_IUPAC04 CS 250.000 3.808172E-21 1.617296E-21 6.738177E-22 2.708044E-22 2.935763E-23 1.936806E-25 0.000000E+00 +HNO3_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HNO3_IUPAC04 CS 270.000 4.011424E-21 1.732176E-21 7.340720E-22 3.024923E-22 3.549917E-23 1.956971E-25 0.000000E+00 +HNO3_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HNO3_IUPAC04 CS 290.000 4.225525E-21 1.855217E-21 7.997143E-22 3.378882E-22 4.292550E-23 1.977347E-25 0.000000E+00 +HNO3_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HNO3_IUPAC04 CS 310.000 4.451052E-21 1.986998E-21 8.712266E-22 3.774259E-22 5.190541E-23 1.997934E-25 0.000000E+00 +HNO3_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +N2O5_IUPAC04 CS 210.000 5.312730E-20 3.282175E-20 2.179652E-20 1.471228E-20 6.061776E-21 6.193672E-22 0.000000E+00 +N2O5_IUPAC04 EQY 210.000 9.185266E-01 9.975538E-01 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +N2O5_IUPAC04 CS 230.000 5.313491E-20 3.282754E-20 2.180121E-20 1.471604E-20 6.064173E-21 6.198977E-22 0.000000E+00 +N2O5_IUPAC04 EQY 230.000 9.185266E-01 9.975538E-01 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +N2O5_IUPAC04 CS 250.000 5.314131E-20 3.283239E-20 2.180514E-20 1.471920E-20 6.066188E-21 6.203437E-22 0.000000E+00 +N2O5_IUPAC04 EQY 250.000 9.185266E-01 9.975538E-01 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +N2O5_IUPAC04 CS 270.000 5.314676E-20 3.283652E-20 2.180850E-20 1.472189E-20 6.067905E-21 6.207238E-22 0.000000E+00 +N2O5_IUPAC04 EQY 270.000 9.185266E-01 9.975538E-01 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +N2O5_IUPAC04 CS 290.000 5.315146E-20 3.284009E-20 2.181139E-20 1.472421E-20 6.069385E-21 6.210516E-22 0.000000E+00 +N2O5_IUPAC04 EQY 290.000 9.185266E-01 9.975538E-01 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +N2O5_IUPAC04 CS 310.000 5.315358E-20 3.284170E-20 2.181269E-20 1.472526E-20 6.070051E-21 6.211993E-22 0.000000E+00 +N2O5_IUPAC04 EQY 310.000 9.185266E-01 9.975538E-01 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +NTR_IUPAC04 CS 210.000 9.389259E-21 4.344341E-21 1.966310E-21 8.483309E-22 1.164059E-22 1.111132E-24 0.000000E+00 +NTR_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +NTR_IUPAC04 CS 230.000 9.389259E-21 4.344341E-21 1.966310E-21 8.483309E-22 1.164059E-22 1.111132E-24 0.000000E+00 +NTR_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +NTR_IUPAC04 CS 250.000 9.849085E-21 4.605015E-21 2.106520E-21 9.242647E-22 1.301860E-22 1.111132E-24 0.000000E+00 +NTR_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +NTR_IUPAC04 CS 270.000 1.083740E-20 5.174226E-21 2.417645E-21 1.097131E-21 1.628329E-22 1.111132E-24 0.000000E+00 +NTR_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +NTR_IUPAC04 CS 290.000 1.192488E-20 5.813796E-21 2.774723E-21 1.302329E-21 2.036668E-22 1.111132E-24 0.000000E+00 +NTR_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +NTR_IUPAC04 CS 310.000 1.312149E-20 6.532420E-21 3.184540E-21 1.545905E-21 2.547406E-22 1.111132E-24 0.000000E+00 +NTR_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +COOH_SAPRC99 CS 210.000 5.623467E-21 3.524633E-21 2.410330E-21 1.699588E-21 7.230005E-22 5.395084E-23 0.000000E+00 +COOH_SAPRC99 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +COOH_SAPRC99 CS 230.000 5.623467E-21 3.524633E-21 2.410330E-21 1.699588E-21 7.230005E-22 5.395084E-23 0.000000E+00 +COOH_SAPRC99 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +COOH_SAPRC99 CS 250.000 5.623467E-21 3.524633E-21 2.410330E-21 1.699588E-21 7.230005E-22 5.395084E-23 0.000000E+00 +COOH_SAPRC99 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +COOH_SAPRC99 CS 270.000 5.623467E-21 3.524633E-21 2.410330E-21 1.699588E-21 7.230005E-22 5.395084E-23 0.000000E+00 +COOH_SAPRC99 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +COOH_SAPRC99 CS 290.000 5.623467E-21 3.524633E-21 2.410330E-21 1.699588E-21 7.230005E-22 5.395084E-23 0.000000E+00 +COOH_SAPRC99 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +COOH_SAPRC99 CS 310.000 5.623467E-21 3.524633E-21 2.410330E-21 1.699588E-21 7.230005E-22 5.395084E-23 0.000000E+00 +COOH_SAPRC99 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +HCHO_R_SAPRC99 CS 210.000 3.194831E-20 3.305599E-20 1.530163E-20 3.253899E-20 1.812818E-20 7.807102E-22 0.000000E+00 +HCHO_R_SAPRC99 EQY 210.000 7.309931E-01 7.594469E-01 7.389138E-01 6.689863E-01 2.623700E-01 0.000000E+00 0.000000E+00 +HCHO_R_SAPRC99 CS 230.000 3.191805E-20 3.305378E-20 1.529304E-20 3.256222E-20 1.813854E-20 7.802038E-22 0.000000E+00 +HCHO_R_SAPRC99 EQY 230.000 7.309931E-01 7.594469E-01 7.389138E-01 6.689863E-01 2.623700E-01 0.000000E+00 0.000000E+00 +HCHO_R_SAPRC99 CS 250.000 3.188778E-20 3.305157E-20 1.528445E-20 3.258546E-20 1.814889E-20 7.796973E-22 0.000000E+00 +HCHO_R_SAPRC99 EQY 250.000 7.309931E-01 7.594469E-01 7.389138E-01 6.689863E-01 2.623700E-01 0.000000E+00 0.000000E+00 +HCHO_R_SAPRC99 CS 270.000 3.185751E-20 3.304937E-20 1.527587E-20 3.260869E-20 1.815925E-20 7.791910E-22 0.000000E+00 +HCHO_R_SAPRC99 EQY 270.000 7.309931E-01 7.594469E-01 7.389138E-01 6.689863E-01 2.623700E-01 0.000000E+00 0.000000E+00 +HCHO_R_SAPRC99 CS 290.000 3.182725E-20 3.304716E-20 1.526728E-20 3.263193E-20 1.816960E-20 7.786845E-22 0.000000E+00 +HCHO_R_SAPRC99 EQY 290.000 7.309931E-01 7.594469E-01 7.389138E-01 6.689863E-01 2.623700E-01 0.000000E+00 0.000000E+00 +HCHO_R_SAPRC99 CS 310.000 3.181211E-20 3.304606E-20 1.526298E-20 3.264354E-20 1.817478E-20 7.784313E-22 0.000000E+00 +HCHO_R_SAPRC99 EQY 310.000 7.309931E-01 7.594469E-01 7.389138E-01 6.689863E-01 2.623700E-01 0.000000E+00 0.000000E+00 +HCHO_M_SAPRC99 CS 210.000 3.194831E-20 3.305599E-20 1.530163E-20 3.253899E-20 1.812818E-20 7.807102E-22 0.000000E+00 +HCHO_M_SAPRC99 EQY 210.000 2.574855E-01 2.405532E-01 2.610862E-01 3.310137E-01 6.270887E-01 9.642900E-02 0.000000E+00 +HCHO_M_SAPRC99 CS 230.000 3.191805E-20 3.305378E-20 1.529304E-20 3.256222E-20 1.813854E-20 7.802038E-22 0.000000E+00 +HCHO_M_SAPRC99 EQY 230.000 2.574855E-01 2.405532E-01 2.610862E-01 3.310137E-01 6.142817E-01 8.434568E-02 0.000000E+00 +HCHO_M_SAPRC99 CS 250.000 3.188778E-20 3.305157E-20 1.528445E-20 3.258546E-20 1.814889E-20 7.796973E-22 0.000000E+00 +HCHO_M_SAPRC99 EQY 250.000 2.574855E-01 2.405532E-01 2.610862E-01 3.310137E-01 5.886566E-01 6.544254E-02 0.000000E+00 +HCHO_M_SAPRC99 CS 270.000 3.185751E-20 3.304937E-20 1.527587E-20 3.260869E-20 1.815925E-20 7.791910E-22 0.000000E+00 +HCHO_M_SAPRC99 EQY 270.000 2.574855E-01 2.405532E-01 2.610862E-01 3.310137E-01 5.633756E-01 5.171735E-02 0.000000E+00 +HCHO_M_SAPRC99 CS 290.000 3.182725E-20 3.304716E-20 1.526728E-20 3.263193E-20 1.816960E-20 7.786845E-22 0.000000E+00 +HCHO_M_SAPRC99 EQY 290.000 2.574855E-01 2.405532E-01 2.610862E-01 3.310137E-01 5.385566E-01 4.153425E-02 0.000000E+00 +HCHO_M_SAPRC99 CS 310.000 3.181211E-20 3.304606E-20 1.526298E-20 3.264354E-20 1.817478E-20 7.784313E-22 0.000000E+00 +HCHO_M_SAPRC99 EQY 310.000 2.574855E-01 2.405532E-01 2.610862E-01 3.310137E-01 5.263071E-01 3.741274E-02 0.000000E+00 +CCHO_R_SAPRC99 CS 210.000 4.432586E-20 3.717937E-20 2.933103E-20 2.104728E-20 3.707365E-21 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 EQY 210.000 4.845355E-01 3.929700E-01 2.873054E-01 1.582196E-01 4.669661E-02 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 CS 230.000 4.432586E-20 3.717937E-20 2.933103E-20 2.104728E-20 3.707365E-21 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 EQY 230.000 4.845355E-01 3.929700E-01 2.873054E-01 1.582196E-01 4.669661E-02 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 CS 250.000 4.432586E-20 3.717937E-20 2.933103E-20 2.104728E-20 3.707365E-21 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 EQY 250.000 4.845355E-01 3.929700E-01 2.873054E-01 1.582196E-01 4.669661E-02 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 CS 270.000 4.432586E-20 3.717937E-20 2.933103E-20 2.104728E-20 3.707365E-21 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 EQY 270.000 4.845355E-01 3.929700E-01 2.873054E-01 1.582196E-01 4.669661E-02 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 CS 290.000 4.432586E-20 3.717937E-20 2.933103E-20 2.104728E-20 3.707365E-21 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 EQY 290.000 4.845355E-01 3.929700E-01 2.873054E-01 1.582196E-01 4.669661E-02 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 CS 310.000 4.432586E-20 3.717937E-20 2.933103E-20 2.104728E-20 3.707365E-21 0.000000E+00 0.000000E+00 +CCHO_R_SAPRC99 EQY 310.000 4.845355E-01 3.929700E-01 2.873054E-01 1.582196E-01 4.669661E-02 0.000000E+00 0.000000E+00 +PAN_IUPAC04 CS 210.000 1.739171E-21 6.582610E-22 3.002032E-22 1.553851E-22 3.362601E-23 9.835697E-25 0.000000E+00 +PAN_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +PAN_IUPAC04 CS 230.000 2.037982E-21 7.830614E-22 3.604711E-22 1.884599E-22 4.221305E-23 9.942392E-25 0.000000E+00 +PAN_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +PAN_IUPAC04 CS 250.000 2.388133E-21 9.315228E-22 4.328382E-22 2.285749E-22 5.299293E-23 1.005024E-24 0.000000E+00 +PAN_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +PAN_IUPAC04 CS 270.000 2.798445E-21 1.108131E-21 5.197335E-22 2.772287E-22 6.652567E-23 1.015927E-24 0.000000E+00 +PAN_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +PAN_IUPAC04 CS 290.000 3.279253E-21 1.318223E-21 6.240736E-22 3.362388E-22 8.351424E-23 1.026947E-24 0.000000E+00 +PAN_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +PAN_IUPAC04 CS 310.000 3.842670E-21 1.568146E-21 7.493608E-22 4.078096E-22 1.048412E-22 1.038087E-24 0.000000E+00 +PAN_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +PACD_CB05 CS 210.000 7.759271E-22 4.128908E-22 2.430012E-22 1.524872E-22 2.672513E-23 0.000000E+00 0.000000E+00 +PACD_CB05 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +PACD_CB05 CS 230.000 7.759271E-22 4.128908E-22 2.430012E-22 1.524872E-22 2.672513E-23 0.000000E+00 0.000000E+00 +PACD_CB05 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +PACD_CB05 CS 250.000 7.759271E-22 4.128908E-22 2.430012E-22 1.524872E-22 2.672513E-23 0.000000E+00 0.000000E+00 +PACD_CB05 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +PACD_CB05 CS 270.000 7.759271E-22 4.128908E-22 2.430012E-22 1.524872E-22 2.672513E-23 0.000000E+00 0.000000E+00 +PACD_CB05 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +PACD_CB05 CS 290.000 7.759271E-22 4.128908E-22 2.430012E-22 1.524872E-22 2.672513E-23 0.000000E+00 0.000000E+00 +PACD_CB05 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +PACD_CB05 CS 310.000 7.759271E-22 4.128908E-22 2.430012E-22 1.524872E-22 2.672513E-23 0.000000E+00 0.000000E+00 +PACD_CB05 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 CS 210.000 3.094719E-20 4.634689E-20 3.579653E-20 2.441742E-20 5.808274E-21 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 EQY 210.000 8.795307E-01 8.013052E-01 5.960570E-01 4.412259E-01 2.382693E-01 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 CS 230.000 3.094719E-20 4.634689E-20 3.579653E-20 2.441742E-20 5.808274E-21 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 EQY 230.000 8.795307E-01 8.013052E-01 5.960570E-01 4.412259E-01 2.382693E-01 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 CS 250.000 3.094719E-20 4.634689E-20 3.579653E-20 2.441742E-20 5.808274E-21 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 EQY 250.000 8.795307E-01 8.013052E-01 5.960570E-01 4.412259E-01 2.382693E-01 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 CS 270.000 3.094719E-20 4.634689E-20 3.579653E-20 2.441742E-20 5.808274E-21 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 EQY 270.000 8.795307E-01 8.013052E-01 5.960570E-01 4.412259E-01 2.382693E-01 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 CS 290.000 3.094719E-20 4.634689E-20 3.579653E-20 2.441742E-20 5.808274E-21 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 EQY 290.000 8.795307E-01 8.013052E-01 5.960570E-01 4.412259E-01 2.382693E-01 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 CS 310.000 3.094719E-20 4.634689E-20 3.579653E-20 2.441742E-20 5.808274E-21 0.000000E+00 0.000000E+00 +C2CHO_SAPRC99 EQY 310.000 8.795307E-01 8.013052E-01 5.960570E-01 4.412259E-01 2.382693E-01 0.000000E+00 0.000000E+00 +MGLY_IUPAC04 CS 210.000 4.380391E-20 3.467071E-20 2.430916E-20 1.788232E-20 6.183676E-21 3.700269E-20 7.900421E-21 +MGLY_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 2.208002E-01 0.000000E+00 +MGLY_IUPAC04 CS 230.000 4.380391E-20 3.467071E-20 2.430916E-20 1.788232E-20 6.183676E-21 3.700269E-20 7.900421E-21 +MGLY_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 2.208002E-01 0.000000E+00 +MGLY_IUPAC04 CS 250.000 4.380391E-20 3.467071E-20 2.430916E-20 1.788232E-20 6.183676E-21 3.700269E-20 7.900421E-21 +MGLY_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 2.208002E-01 0.000000E+00 +MGLY_IUPAC04 CS 270.000 4.380391E-20 3.467071E-20 2.430916E-20 1.788232E-20 6.183676E-21 3.700269E-20 7.900421E-21 +MGLY_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 2.208002E-01 0.000000E+00 +MGLY_IUPAC04 CS 290.000 4.380391E-20 3.467071E-20 2.430916E-20 1.788232E-20 6.183676E-21 3.700269E-20 7.900421E-21 +MGLY_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 2.208002E-01 0.000000E+00 +MGLY_IUPAC04 CS 310.000 4.380391E-20 3.467071E-20 2.430916E-20 1.788232E-20 6.183676E-21 3.700269E-20 7.900421E-21 +MGLY_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 2.208002E-01 0.000000E+00 +ACROLEIN_SAPRC99 CS 210.000 2.119555E-20 3.145168E-20 4.081558E-20 4.837755E-20 5.750342E-20 1.189679E-20 0.000000E+00 +ACROLEIN_SAPRC99 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +ACROLEIN_SAPRC99 CS 230.000 2.119555E-20 3.145168E-20 4.081558E-20 4.837755E-20 5.750342E-20 1.189679E-20 0.000000E+00 +ACROLEIN_SAPRC99 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +ACROLEIN_SAPRC99 CS 250.000 2.119555E-20 3.145168E-20 4.081558E-20 4.837755E-20 5.750342E-20 1.189679E-20 0.000000E+00 +ACROLEIN_SAPRC99 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +ACROLEIN_SAPRC99 CS 270.000 2.119555E-20 3.145168E-20 4.081558E-20 4.837755E-20 5.750342E-20 1.189679E-20 0.000000E+00 +ACROLEIN_SAPRC99 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +ACROLEIN_SAPRC99 CS 290.000 2.119555E-20 3.145168E-20 4.081558E-20 4.837755E-20 5.750342E-20 1.189679E-20 0.000000E+00 +ACROLEIN_SAPRC99 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +ACROLEIN_SAPRC99 CS 310.000 2.119555E-20 3.145168E-20 4.081558E-20 4.837755E-20 5.750342E-20 1.189679E-20 0.000000E+00 +ACROLEIN_SAPRC99 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 +CL2_IUPAC04 CS 210.000 8.017935E-20 1.378075E-19 1.883493E-19 2.304088E-19 2.671696E-19 3.907318E-20 0.000000E+00 +CL2_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +CL2_IUPAC04 CS 230.000 8.079310E-20 1.380587E-19 1.880621E-19 2.295621E-19 2.657760E-19 3.962987E-20 0.000000E+00 +CL2_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +CL2_IUPAC04 CS 250.000 8.152103E-20 1.383467E-19 1.877078E-19 2.285444E-19 2.641126E-19 4.030003E-20 0.000000E+00 +CL2_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +CL2_IUPAC04 CS 270.000 8.234784E-20 1.386606E-19 1.872867E-19 2.273701E-19 2.622084E-19 4.107465E-20 0.000000E+00 +CL2_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +CL2_IUPAC04 CS 290.000 8.325602E-20 1.389885E-19 1.868006E-19 2.260564E-19 2.600970E-19 4.194252E-20 0.000000E+00 +CL2_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +CL2_IUPAC04 CS 310.000 8.373497E-20 1.391542E-19 1.865338E-19 2.253530E-19 2.589744E-19 4.240762E-20 0.000000E+00 +CL2_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +HOCL_IUPAC04 CS 210.000 5.570117E-20 6.066934E-20 5.958161E-20 5.377945E-20 3.120855E-20 6.545254E-21 1.170137E-23 +HOCL_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +HOCL_IUPAC04 CS 230.000 5.570117E-20 6.066934E-20 5.958161E-20 5.377945E-20 3.120855E-20 6.545254E-21 1.170137E-23 +HOCL_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +HOCL_IUPAC04 CS 250.000 5.570117E-20 6.066934E-20 5.958161E-20 5.377945E-20 3.120855E-20 6.545254E-21 1.170137E-23 +HOCL_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +HOCL_IUPAC04 CS 270.000 5.570117E-20 6.066934E-20 5.958161E-20 5.377945E-20 3.120855E-20 6.545254E-21 1.170137E-23 +HOCL_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +HOCL_IUPAC04 CS 290.000 5.570117E-20 6.066934E-20 5.958161E-20 5.377945E-20 3.120855E-20 6.545254E-21 1.170137E-23 +HOCL_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +HOCL_IUPAC04 CS 310.000 5.570117E-20 6.066934E-20 5.958161E-20 5.377945E-20 3.120855E-20 6.545254E-21 1.170137E-23 +HOCL_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 +FMCL_IUPAC04 CS 210.000 5.320050E-21 1.421323E-21 2.242342E-22 8.338288E-23 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 EQY 210.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 CS 230.000 5.320050E-21 1.421323E-21 2.242342E-22 8.338288E-23 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 EQY 230.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 CS 250.000 5.320050E-21 1.421323E-21 2.242342E-22 8.338288E-23 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 EQY 250.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 CS 270.000 5.320050E-21 1.421323E-21 2.242342E-22 8.338288E-23 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 EQY 270.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 CS 290.000 5.320050E-21 1.421323E-21 2.242342E-22 8.338288E-23 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 EQY 290.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 CS 310.000 5.320050E-21 1.421323E-21 2.242342E-22 8.338288E-23 0.000000E+00 0.000000E+00 0.000000E+00 +FMCL_IUPAC04 EQY 310.000 1.000000E+00 1.000000E+00 1.000000E+00 1.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 +! Ozone Cross-Section for Stratospheric Opacity based on Table 4-5 in +! Chemical Kinetics and Photochemical Data for Use in Atmospheric +! Studies Evaluation Number 15. Sander et. al: NASA-JPL 2006 +NTEMP_STRAT = 6 +! QUANTITY TEMP WBIN( 1) WBIN( 2) WBIN( 3) WBIN( 4) WBIN( 5) WBIN( 6) WBIN( 7) +O3_STRAT CS 180.000 6.113743E-19 2.263004E-19 8.354117E-20 3.417408E-20 3.688351E-21 4.086261E-23 1.663175E-21 +O3_STRAT CS 260.000 6.434133E-19 2.434104E-19 9.254548E-20 3.928807E-20 4.583227E-21 4.086261E-23 1.663175E-21 +O3_STRAT CS 300.000 6.685868E-19 2.568540E-19 9.962031E-20 4.330621E-20 5.286344E-21 4.086261E-23 1.663175E-21 +O3_STRAT CS 340.000 6.685868E-19 2.568540E-19 9.962031E-20 4.330621E-20 5.286344E-21 4.086261E-23 1.663175E-21 +O3_STRAT CS 380.000 6.685868E-19 2.568540E-19 9.962031E-20 4.330621E-20 5.286344E-21 4.086261E-23 1.663175E-21 +O3_STRAT CS 420.000 6.685868E-19 2.568540E-19 9.962031E-20 4.330621E-20 5.286344E-21 4.086261E-23 1.663175E-21 +! Surface Albedo with wavelength dependence for 20 MODIS land use types. +! Correction factors are included for solar zenith angle and season. +! Note that an adjustment is used better match spectral estimates. +! REFERENCE: CERES/SARB Surface Properties database, May 2006 +! http://www-surf.larc.nasa.gov/surf/pages/explan.html. +NUMB_LANDUSE_MODIS = 20 +! Following two indices denote the categories assigned as generic +! land and water surfaces. The surfaces are used as the default +! land characterization scheme if scheme used is not known. +INDEX_GRASSLAND = 10 +INDEX_OCEAN_WATER = 17 + INDEX_SEA_ICE = 20 +! I, LANDUSE_CATEGORY, ZENITH_ANGLE_COEFF, SEASONAL_COEFF, SNOW_COVER_COEEF, + 1 EVERGREEN NEEDLE FOREST 0.400 0.730 3.000 + 2 EVERGREEN BROADLEAF FOREST 0.440 0.840 4.100 + 3 DECIDUOUS NEEDLE FOREST 0.320 0.770 3.100 + 4 DECIDUOUS BROADLEAF FOREST 0.390 0.730 2.700 + 5 MIXED FOREST 0.220 0.780 3.000 + 6 CLOSED SHRUBS 0.280 0.730 8.600 + 7 OPEN / SHRUBS 0.400 0.770 3.600 + 8 WOODY SAVANNA 0.470 0.780 7.800 + 9 SAVANNA 0.530 0.780 25.900 + 10 GRASSLAND 0.530 0.790 19.600 + 11 PERMANENT WETLANDS 0.350 0.780 4.900 + 12 CROPLAND 0.410 0.800 26.500 + 13 URBAN 0.100 0.670 3.600 + 14 CROP MOSAIC 0.400 0.800 15.900 + 15 PERMANENT SNOW 0.100 1.000 1.700 + 16 BARREN / DESSERT 0.400 0.960 5.700 + 17 OCEAN WATER 0.410 1.000 1.000 + 18 TUNDRA 0.580 0.250 4.000 + 19 FRESH SNOW 0.100 1.000 1.000 + 20 SEA ICE 0.100 1.000 1.300 +! LANDUSE CATEGORY WBIN( 1) WBIN( 2) WBIN( 3) WBIN( 4) WBIN( 5) WBIN( 6) WBIN( 7) + EVERGREEN NEEDLE FOREST 1.120000E-01 1.120000E-01 1.120000E-01 1.120000E-01 1.120000E-01 1.120000E-01 2.389658E-01 + EVERGREEN BROADLEAF FOREST 1.100000E-01 1.100000E-01 1.100000E-01 1.100000E-01 1.100000E-01 1.100000E-01 1.729747E-01 + DECIDUOUS NEEDLE FOREST 1.280000E-01 1.280000E-01 1.280000E-01 1.280000E-01 1.280000E-01 1.280000E-01 2.731038E-01 + DECIDUOUS BROADLEAF FOREST 8.500001E-02 8.500001E-02 8.500001E-02 8.500001E-02 8.500001E-02 8.500001E-02 2.317877E-01 + MIXED FOREST 9.900000E-02 9.900000E-02 9.900000E-02 9.900000E-02 9.900000E-02 9.900000E-02 2.423726E-01 + CLOSED SHRUBS 4.579739E-02 4.861081E-02 5.083271E-02 5.281545E-02 5.821295E-02 9.479410E-02 4.074914E-01 + OPEN / SHRUBS 1.900000E-01 1.900000E-01 1.900000E-01 1.900000E-01 1.900555E-01 1.946607E-01 2.973448E-01 + WOODY SAVANNA 5.782825E-02 5.900450E-02 5.994786E-02 6.100858E-02 6.396866E-02 8.139437E-02 3.139012E-01 + SAVANNA 2.289869E-02 2.430540E-02 2.541636E-02 2.640773E-02 2.910648E-02 4.739705E-02 2.212760E-01 + GRASSLAND 3.053159E-02 3.240721E-02 3.388848E-02 3.521030E-02 3.880863E-02 6.319606E-02 2.950347E-01 + PERMANENT WETLANDS 7.800000E-02 7.800000E-02 7.800000E-02 7.800000E-02 7.800000E-02 7.800000E-02 1.455206E-01 + CROPLAND 2.289869E-02 2.430540E-02 2.541636E-02 2.640773E-02 2.910648E-02 4.739705E-02 2.051391E-01 + URBAN 7.800000E-02 7.800000E-02 7.800000E-02 7.800000E-02 7.800000E-02 7.875838E-02 1.904894E-01 + CROP MOSAIC 3.816449E-02 4.050901E-02 4.236060E-02 4.401288E-02 4.851079E-02 7.899508E-02 2.888656E-01 + PERMANENT SNOW 9.166853E-01 9.190090E-01 9.208957E-01 9.230171E-01 9.286691E-01 9.428869E-01 8.972328E-01 + BARREN / DESSERT 1.440000E-01 1.440000E-01 1.440000E-01 1.440000E-01 1.440000E-01 1.452640E-01 2.949050E-01 + OCEAN WATER 7.040989E-02 7.180540E-02 7.297956E-02 7.481545E-02 7.987999E-02 9.034642E-02 7.636174E-02 + TUNDRA 1.800000E-01 1.800000E-01 1.800000E-01 1.800000E-01 1.800000E-01 1.800000E-01 1.888828E-01 + FRESH SNOW 9.802786E-01 9.812036E-01 9.819302E-01 9.824035E-01 9.835413E-01 9.869627E-01 9.746961E-01 + SEA ICE 7.780000E-01 7.780000E-01 7.780000E-01 7.780000E-01 7.780000E-01 7.780000E-01 7.150455E-01 +! Following maps the above albedo data to three land characterization +! schemes commonly used in CMAQ applications. +! + NUMB_NLCD_MODIS = 50 +! I, LANDUSE_NLCD-MODIS, INDEX_ALBREF, FAC_ALBREF, + 1 Open Water 17 1.000 + 2 Perennial Ice-Snow 15 1.000 + 3 Developed Open Space 13 1.067 + 4 Developed Low Intensity 13 1.133 + 5 Developed Medium Intensity 13 1.067 + 6 Developed High Intensity 13 1.133 + 7 Barren Land (Rock-Sand-Clay) 16 0.800 + 8 Unconsolidated Shore 16 1.400 + 9 Deciduous Forest 4 0.938 + 10 Evergreen Forest 1 0.833 + 11 Mixed Forest 5 1.000 + 12 Dwarf Scrub 7 1.000 + 13 Shrub-Scrub 7 1.000 + 14 Grassland-Herbaceous 8 1.136 + 15 Sedge-Herbaceous 8 1.046 + 16 Lichens 10 1.053 + 17 Moss 10 1.053 + 18 Tundra 18 1.000 + 19 Pasture-Hay 14 1.278 + 20 Cultivated Crops 12 1.176 + 21 Woody Wetlands 11 1.071 + 22 Palustrine Forested Wetland 11 1.071 + 23 Palustrine Scrub-Shrub Wetland 11 1.071 + 24 Estuarine Forested Wetland 11 1.071 + 25 Estuarine Scrub-Shrub Wetland 11 1.071 + 26 Emergent Herbaceous Wetlands 11 1.286 + 27 Palustrine Emergent Wetland 11 1.286 + 28 Estuarine Emergent Wetland 11 1.286 + 29 Palustrine Aquatic Bed 17 1.250 + 30 Estuarine Aquatic Bed 17 1.250 + 31 Water 17 1.000 + 32 Evergreen Needleleaf Forest 1 1.000 + 33 Evergreen Broadleaf Forest 2 1.000 + 34 Deciduous Needleleaf Forest 3 1.000 + 35 Deciduous Broadleaf Forest 4 1.000 + 36 Mixed Forests 5 1.000 + 37 Closed Shrublands 6 1.000 + 38 Open Shrublands 7 1.000 + 39 Woody Savannas 8 1.000 + 40 Savannas 9 1.000 + 41 Grasslands 10 1.000 + 42 Permanent Wetlands 11 1.000 + 43 Croplands 12 1.000 + 44 Urban and Built Up 13 1.000 + 45 Cropland-Natural Vegetation Mosaic 14 1.000 + 46 Permanent Snow and Ice 15 1.000 + 47 Barren or Sparsely Vegetated 16 1.000 + 48 IGBP Water 17 1.000 + 49 unclassified 17 1.000 + 50 fill value 17 1.000 + NUMB_USGS = 24 +! I, LANDUSE_USGS, INDEX_ALBREF, FAC_ALBREF, + 1 Urban Land 13 1.000 + 2 Dryland Cropland and Pasture 12 1.000 + 3 Irrigated Cropland and Pasture 12 1.059 + 4 Mixed Dryland and Irrigated Cropland and Pasture 12 1.059 + 5 Cropland-Grassland Mosaic 14 1.000 + 6 Cropland-Woodland Mosaic 14 0.889 + 7 Grassland 10 1.000 + 8 Shrubland 7 1.000 + 9 Mixed Shrubland-Grassland 7 1.000 + 10 Savannah 9 1.000 + 11 Deciduous Broadleaf Forest 4 1.000 + 12 Deciduous Needleleaf Forest 3 1.000 + 13 Evergreen Broadleaf Forest 2 1.000 + 14 Evergreen Needleleaf Forest 1 1.000 + 15 Mixed Forest 5 1.000 + 16 Water 17 1.000 + 17 Herbaceous Wetland 11 1.000 + 18 Wooded Wetland 11 1.000 + 19 Barren or Sparsely Vegetated 16 1.000 + 20 Herbaceous Tundra 18 1.000 + 21 Wooded Tundra 18 1.000 + 22 Mixed Tundra 18 1.000 + 23 Bare Ground Tundra 18 1.000 + 24 Snow or Ice 15 1.000 + NUMB_MODIS_NOAH = 33 +! I, LANDUSE_MODIS-NOAH, INDEX_ALBREF, FAC_ALBREF, + 1 Evergreen Needleleaf Forest 1 1.000 + 2 Evergreen Broadleaf Forest 2 1.000 + 3 Deciduous Needleleaf Forest 3 1.000 + 4 Deciduous Broadleaf Forest 4 1.000 + 5 Mixed Forests 5 1.000 + 6 Closed Shrublands 6 1.000 + 7 Open Shrublands 7 1.000 + 8 Woody Savannas 8 1.000 + 9 Savannas 9 1.000 + 10 Grasslands 10 1.000 + 11 Permanent Wetlands 11 1.000 + 12 Croplands 12 1.000 + 13 Urban and Built-Up 13 1.000 + 14 Cropland-Natural Vegetation Mosaic 14 1.000 + 15 Snow and Ice 15 1.000 + 16 Barren or Sparsely Vegetated 16 1.000 + 17 Water 17 1.000 + 18 Wooded Tundra 18 1.000 + 19 Mixed Tundra 18 1.000 + 20 Barren Tundra 18 1.000 + 21 ~~~unassigned~~~ -1 0.000 + 22 ~~~unassigned~~~ -1 0.000 + 23 ~~~unassigned~~~ -1 0.000 + 24 ~~~unassigned~~~ -1 0.000 + 25 ~~~unassigned~~~ -1 0.000 + 26 ~~~unassigned~~~ -1 0.000 + 27 ~~~unassigned~~~ -1 0.000 + 28 ~~~unassigned~~~ -1 0.000 + 29 ~~~unassigned~~~ -1 0.000 + 30 ~~~unassigned~~~ -1 0.000 + 31 Low Intensity Residential 13 1.000 + 32 High Intensity Residential 13 1.000 + 33 Industrial or Commercial 13 1.000 + NUMB_NLCD40_MODIS = 40 +! I, LANDUSE_NLCD40-MODIS, INDEX_ALBREF, FAC_ALBREF, + 1 Evergreen Needleleaf Forest 1 1.000 + 2 Evergreen Broadleaf Forest 2 1.000 + 3 Deciduous Needleleaf Forest 3 1.000 + 4 Deciduous Broadleaf Forest 4 1.000 + 5 Mixed Forests 5 1.000 + 6 Closed Shrublands 6 1.000 + 7 Open Shrublands 7 1.000 + 8 Woody Savannas 8 1.000 + 9 Savannas 9 1.000 + 10 Grasslands 10 1.000 + 11 Permanent Wetlands 11 1.000 + 12 Croplands 12 1.000 + 13 Urban and Built Up 13 1.000 + 14 Cropland-Natural Vegetation Mosaic 14 1.000 + 15 Permanent Snow and Ice 15 1.000 + 16 Barren or Sparsely Vegetated 16 1.000 + 17 IGBP Water 17 1.000 + 18 unclassified 17 1.000 + 19 fill value 17 1.000 + 20 Open Water 17 1.000 + 21 Perennial Ice-Snow 15 1.000 + 22 Developed Open Space 13 1.067 + 23 Developed Low Intensity 13 1.133 + 24 Developed Medium Intensity 13 1.067 + 25 Developed High Intensity 13 1.133 + 26 Barren Land (Rock-Sand-Clay) 16 0.800 + 27 Unconsolidated Shore 16 1.400 + 28 Deciduous Forest 4 0.938 + 29 Evergreen Forest 1 0.833 + 30 Mixed Forest 5 1.000 + 31 Dwarf Scrub 7 1.000 + 32 Shrub-Scrub 7 1.000 + 33 Grassland-Herbaceous 8 1.136 + 34 Sedge-Herbaceous 8 1.046 + 35 Lichens 10 1.053 + 36 Moss 10 1.053 + 37 Pasture-Hay 14 1.278 + 38 Cultivated Crops 12 1.176 + 39 Woody Wetlands 11 1.071 + 40 Emergent Herbaceous Wetlands 11 1.286 diff --git a/models/CCTM/MECHS/CH4only/GC_CH4only.csv b/models/CCTM/MECHS/CH4only/GC_CH4only.csv new file mode 100755 index 0000000..cb90574 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/GC_CH4only.csv @@ -0,0 +1,2 @@ +SPC,MOLWT,EMIS_SUR,EMIS_FAC,DEPV_SUR,DEPV_FAC,ICBC_SUR,ICBC_FAC,SCAV_SUR,SCAV_FAC,G2AE_SUR,G2AQ_SUR,TRNS,DDEP,WDEP,CONC +CH4,16.0,CH4,1.0,,,CH4,1.0,,,,,Yes,,,Yes diff --git a/models/CCTM/MECHS/CH4only/GC_CH4only.nml b/models/CCTM/MECHS/CH4only/GC_CH4only.nml new file mode 100755 index 0000000..a8b5233 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/GC_CH4only.nml @@ -0,0 +1,14 @@ +! RCS file, release, date & time of last delta, author, state, [and locker] +! $Header: /project/yoj/arc/MECHS/src/cb05cl_ae5_aq/GC_cb05cl_ae5_aq.nml,v 1.1 2011/12/09 11:49:57 yoj Exp $ + +&GC_nml + +n_surr1 = 4, +n_surr2 = 2, +n_ctrl = 4, + +TYPE_HEADER = +'SPC:MOLWT:EMIS_SUR:EMIS_FAC:DEPV_SUR:DEPV_FAC:ICBC_SUR:ICBC_FAC:SCAV_SUR:SCAV_FAC:G2AE_SUR:G2AQ_SUR:TRNS:DDEP:WDEP:CONC', +TYPE_MATRIX = +'CH4:16.0:CH4:1.0::1.0:CH4:1.0:::::Yes:No:No:Yes', +/ diff --git a/models/CCTM/MECHS/CH4only/NR_CH4only.csv b/models/CCTM/MECHS/CH4only/NR_CH4only.csv new file mode 100755 index 0000000..02c00b8 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/NR_CH4only.csv @@ -0,0 +1 @@ +SPC,MOLWT,EMIS_SUR,EMIS_FAC,DEPV_SUR,DEPV_FAC,ICBC_SUR,ICBC_FAC,SCAV_SUR,SCAV_FAC,N2AE_SUR,N2AQ_SUR,TRNS,DDEP,WDEP,CONC diff --git a/models/CCTM/MECHS/CH4only/NR_CH4only.nml b/models/CCTM/MECHS/CH4only/NR_CH4only.nml new file mode 100755 index 0000000..3c0d4d0 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/NR_CH4only.nml @@ -0,0 +1,13 @@ +! RCS file, release, date & time of last delta, author, state, [and locker] +! $Header: /project/yoj/arc/MECHS/src/cb05cl_ae5_aq/NR_cb05cl_ae5_aq.nml,v 1.1 2011/12/09 11:49:57 yoj Exp $ + +&NR_nml + +n_surr1 = 4, +n_surr2 = 2, +n_ctrl = 4, + +TYPE_HEADER = +'SPC:MOLWT:EMIS_SUR:EMIS_FAC:DEPV_SUR:DEPV_FAC:ICBC_SUR:ICBC_FAC:SCAV_SUR:SCAV_FAC:N2AE_SUR:N2AQ_SUR:TRNS:DDEP:WDEP:CONC', +TYPE_MATRIX = +/ diff --git a/models/CCTM/MECHS/CH4only/RXCM.EXT b/models/CCTM/MECHS/CH4only/RXCM.EXT new file mode 100755 index 0000000..6445411 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/RXCM.EXT @@ -0,0 +1,262 @@ + +C RCS file, release, date & time of last delta, author, state, [and locker] +C $Header: /project/yoj/arc/MECHS/src/cb05cl_ae5_aq/RXCM.EXT,v 1.2 2011/03/24 16:15:48 sjr Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C -------- Mechanism Reactions, Rates, etc. COMMON INCLUDE File -------- +C /home/hutzellb/cmaq_toxics/releases_2010/new_arc_mechanisms +C /cb05cl_ae5_aq/RXCM.EXT +C for Mechanism Name: CB05CL_AE5_AQ + +C The following are reserved symbols declared in this INCLUDE file: +C MECHNAME = Mechanism name +C N_GAS_CHEM_SPC = Total number of species in gas phase chemical mechanism +C N_ACT_SP = Number of active (determined by ODE solver) species in mechanism +C NRXNS = Number of mechanism reactions +C KUNITS = Units of mechanism reactions +C KTYPE = Reaction type +C IRXBITS = Bit test mask vector for selected reactions +C IORDER = Order of the reaction +C KTN1 = Number of type 1 reactions +C KRX1 = Reactions list pointer to type 1 reactions +C KTN2 = Number of type 2 reactions +C KRX2 = Reactions list pointer to type 2 reactions +C KTN3 = Number of type 3 reactions +C KRX3 = Reactions list pointer to type 3 reactions +C KTN4 = Number of type 4 reactions +C KRX4 = Reactions list pointer to type 4 reactions +C KTN5 = Number of type 5 reactions +C KRX5 = Reactions list pointer to type 5 reactions +C KTN6 = Number of type 6 reactions +C KRX6 = Reactions list pointer to type 6 reactions +C KTN7 = Number of type 7 reactions +C KRX7 = Reactions list pointer to type 7 reactions + +C NWM = Number of air 3-body reactions +C NRXWM = Reactions list pointer to air 3-body reactions +C ATM_AIR = air 3-body reactions concentration +C NWW = Number of H2O 3-body reactions +C NRXWW = Reactions list pointer to H2O 3-body reactions +C NWO2 = Number of reactions with O2 +C NRXWO2 = Reactions list pointer to O2 reactions +C ATM_O2 = Oxygen reactions concentration +C NWN2 = Number of N2 3-body reactions +C NRXWN2 = Reactions list pointer to N2 3-body reactions +C ATM_N2 = Nitrogen 3-body reactions concentration +C NWCH4 = Number of reactions with CH4 +C NRXWCH4 = Reactions list pointer to CH4 reactions +C ATM_CH4 = Methane reactions concentration +C NWH2 = Number of reactions with H2 +C NRXWH2 = Reactions list pointer to H2 reactions +C ATM_H2 = Hydrogen reactions concentration + +C MXPRD = Maximum number of mechanism reaction products +C IRR = Reactions list pointer to reactants and products +C RTDAT = Kinetic reaction rates expressions components +C NFALLOFFF = Number of falloff reactions +C IRRFALL = Reactions list pointer to falloff reactions +C RFDAT = Falloff reaction rates expressions components +C SC = Stoichiometric coefficients +C NREACT = Number of reactants in each mechanism reaction +C NPRDCT = Number of products in each mechanism reaction +C RXLABEL = Character label list for mechanism reactions +C NMPHOT = Number of mechanism photolytic reactions +C NPHOTAB = Number of photolytic reactions tables +C IPH = Reactions list pointer to photolytic reactions and tables + + CHARACTER( 32 ), PARAMETER :: MECHNAME = 'CH4only' + + INTEGER, PARAMETER :: N_GAS_CHEM_SPC = 1 + + INTEGER, PARAMETER :: N_ACT_SP = 1 + + INTEGER, PARAMETER :: NRXNS = 1 + + INTEGER :: KUNITS + + INTEGER :: KTYPE( NRXNS ) + + INTEGER :: IRXBITS( NRXNS ) + + INTEGER :: IORDER( NRXNS ) + + INTEGER, PARAMETER :: KTN1 = 1 + INTEGER :: KRX1( KTN1 ) + + INTEGER, PARAMETER :: KTN2 = 1 + INTEGER :: KRX2( KTN2 ) + + INTEGER, PARAMETER :: KTN3 = 1 + INTEGER :: KRX3( KTN3 ) + + INTEGER, PARAMETER :: KTN4 = 1 + INTEGER :: KRX4( KTN4 ) + + INTEGER, PARAMETER :: KTN5 = 0 + INTEGER :: KRX5( 1 ) + + INTEGER, PARAMETER :: KTN6 = 0 + INTEGER :: KRX6( 1 ) + + INTEGER, PARAMETER :: KTN7 = 0 + INTEGER :: KRX7( 1 ) + + INTEGER, PARAMETER :: NWM = 2 + INTEGER :: NRXWM( NWM ) + REAL, PARAMETER :: ATM_AIR = 1.00000E+06 + + INTEGER, PARAMETER :: NWW = 6 + INTEGER :: NRXWW( NWW ) + + INTEGER, PARAMETER :: NWO2 = 2 + INTEGER :: NRXWO2( NWO2 ) + REAL, PARAMETER :: ATM_O2 = 2.09500E+05 + + INTEGER, PARAMETER :: NWN2 = 0 + INTEGER :: NRXWN2( 1 ) + REAL, PARAMETER :: ATM_N2 = 7.80800E+05 + + INTEGER, PARAMETER :: NWCH4 = 2 + INTEGER :: NRXWCH4( NWCH4 ) + REAL, PARAMETER :: ATM_CH4 = 1.85000E+00 + + INTEGER, PARAMETER :: NWH2 = 2 + INTEGER :: NRXWH2( NWH2 ) + REAL, PARAMETER :: ATM_H2 = 5.60000E-01 + + INTEGER, PARAMETER :: MXPRD = 10 + INTEGER :: IRR( NRXNS,MXPRD+3 ) + + INTEGER, PARAMETER :: NFALLOFF = 19 + INTEGER :: IRRFALL( NFALLOFF ) + + REAL :: SC( NRXNS,MXPRD ) + + INTEGER :: NREACT( NRXNS ) + INTEGER :: NPRDCT( NRXNS ) + + INTEGER, PARAMETER :: NMPHOT = 26 + INTEGER :: IPH( NMPHOT,3 ) + + COMMON / MECHRX1 / + & KUNITS, + & KTYPE, + & IRXBITS, + & IORDER, + & KRX1, + & KRX2, + & KRX3, + & KRX4, + & KRX7, + & KRX5, + & KRX6, + & NRXWM, + & NRXWW, + & NRXWO2, + & NRXWN2, + & NRXWCH4, + & NRXWH2, + & IRR, + & IRRFALL, + & SC, + & NREACT, + & NPRDCT, + & IPH + + REAL( 8 ) :: RTDAT( 3,NRXNS ) + REAL( 8 ) :: RFDAT( 5,NFALLOFF ) + + COMMON / MECHRX2 / + & RTDAT, + & RFDAT + + INTEGER, PARAMETER :: NPHOTAB = 23 + CHARACTER( 16 ) :: PHOTAB( NPHOTAB ) + + CHARACTER( 16 ) :: RXLABEL( NRXNS ) + + COMMON / MECHRX3 / + & PHOTAB, + & RXLABEL + +C End of Mechanism Reactions, Rates, etc. COMMON INCLUDE File ---------- + +C NSPECIAL = Number of special rate coefficients +C SPECIAL = Names of special rate coefficients +C NSPECIAL_RXN = Number of reactions with special rates +C ISPECIAL = Pointers to reactions using special rates and their special rate coefficients +C MAXSPECTERMS = Max Number of each term type in special rate coefficients +C KC_COEFFS = Coefficients of standard rate coefficients times concentration terms +C INDEX_KTERMS = Pointers to standard rate coefficients in special rate coefficients +C INDEX_CTERMS = Pointers to species concentrations in special rate coefficients +C OPERATOR_COEFFS = Coefficients of preceeding special rate coefficients used in special coefficient +C OPERATORS = Pointers to preceeding special rate coefficients used in special coefficient + +C Special Rate information not available .. + INTEGER, PARAMETER :: NSPECIAL_RXN = 0 + INTEGER :: ISPECIAL( 1, 2 ) + +C Special Rate information not available ... + INTEGER, PARAMETER :: NSPECIAL = 0 + +C Special Rate information not available ... + CHARACTER( 16 ) :: SPECIAL( 1 ) + + INTEGER, PARAMETER :: MAXSPECTERMS = 10 + REAL( 8 ) :: KC_COEFFS( NSPECIAL + 1, MAXSPECTERMS) + INTEGER :: INDEX_KTERMS( NSPECIAL + 1, MAXSPECTERMS) + INTEGER :: INDEX_CTERMS( NSPECIAL + 1, MAXSPECTERMS) + REAL( 8 ) :: OPERATOR_COEFFS( NSPECIAL + 1, MAXSPECTERMS) + INTEGER :: OPERATORS( NSPECIAL + 1, MAXSPECTERMS) + + COMMON / MECHRX4 / + & SPECIAL, + & ISPECIAL, + & KC_COEFFS, + & INDEX_KTERMS, + & INDEX_CTERMS, + & OPERATOR_COEFFS, + & OPERATORS + + +C Steady-state species section +C N_SS_SPC = Number of species assumed to be in steady-state +C SS_SPC_DIM = Dimension paramete for steady-state species +C SS_SPC = Names of species assumed to be in steady-state +C MAX_SS_LOSS = Max no. of SS loss rxns for any SS species +C MAX_SS_PROD = Max no. of SS prod rxns for any SS species +C N_LOSS_RXNS = No. of SS loss rxns for each SS species +C N_PROD_RXNS = No. of SS prod rxns for each SS species +C SS_LOSS_RXNS = List of SS loss rxns for each SS species +C SS_PROD_RXNS = List of SS prod rxns for each SS species +C SS_PROD_COEF = List of SS prod yields for each SS species +C SS_RCT_IND = SS species index if it is a rxn reactant + + INTEGER, PARAMETER :: N_SS_SPC = 0 + + INTEGER, PARAMETER :: SS_SPC_DIM = 1 + + INTEGER, PARAMETER :: MAX_SS_LOSS = 0 + + INTEGER, PARAMETER :: MAX_SS_PROD = 0 + + CHARACTER( 16 ) :: SS_SPC( 1 ) + + INTEGER :: N_LOSS_RXNS( 1 ) + INTEGER :: N_PROD_RXNS( 1 ) + INTEGER :: SS_LOSS_RXNS( 1, 1 ) + INTEGER :: SS_PROD_RXNS( 1, 1 ) + INTEGER :: SS_RCT_IND( 1 ) + + REAL :: SS_PROD_COEF( 1,1 ) + + COMMON / MECHRX5 / + & SS_SPC, + & N_LOSS_RXNS, + & N_PROD_RXNS, + & SS_LOSS_RXNS, + & SS_PROD_RXNS, + & SS_PROD_COEF, + & SS_RCT_IND diff --git a/models/CCTM/MECHS/CH4only/RXDT.EXT b/models/CCTM/MECHS/CH4only/RXDT.EXT new file mode 100755 index 0000000..2a1565a --- /dev/null +++ b/models/CCTM/MECHS/CH4only/RXDT.EXT @@ -0,0 +1,145 @@ + +C RCS file, release, date & time of last delta, author, state, [and locker] +C $Header: /project/yoj/arc/MECHS/src/cb05cl_ae5_aq/RXDT.EXT,v 1.3 2011/08/30 21:03:49 sjr Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C --------- Mechanism Reactions, Rates, etc. DATA INCLUDE File --------- +C /home/hutzellb/cmaq_toxics/releases_2010/new_arc_mechanisms +C /cb05cl_ae5_aq/RXDT.EXT +C Generated from ... +C /home/hutzellb/cmaq_toxics/releases_2010/new_arc_mechanisms +C /cb05cl_ae5_aq/mech.def +C for Mechanism Name: CB05CL_AE5_AQ + +C This DATA INCLUDE file must be preceded by the corresponding +C COMMON INCLUDE file, which contains all the appropriate type +C declarations for this file. The DATA INCLUDE file is meant +C to load the COMMON INCLUDE file. + +C The following are reserved symbols declared in this INCLUDE file: +C IRXXN = Reactions index + + CHARACTER( 16 ) :: GAS_CHEM_SPC( N_GAS_CHEM_SPC ) + +! The below character array lists the species names used in the +! gas phase chemistry. The names and their order MUST agree with +! the GC_SPC array for the gas phase chemistry to work correctly. + DATA GAS_CHEM_SPC( 1 ) / 'CH4 ' / + +c$$$ DATA KUNITS / 2 / +c$$$ + INTEGER IRXXN +c$$$ +c$$$ DATA ( KTYPE( IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRXBITS( IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IORDER( IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( KRX1( IRXXN ), IRXXN = 1, KTN1 ) / / +c$$$ +c$$$ DATA ( KRX2( IRXXN ), IRXXN = 1, KTN2 ) / / +c$$$ +c$$$ DATA ( KRX3( IRXXN ), IRXXN = 1, KTN3 ) / / +c$$$ +c$$$ DATA ( KRX4( IRXXN ), IRXXN = 1, KTN4 ) / / +c$$$ +c$$$ DATA KRX5( 1 ) / 0 / +c$$$ +c$$$ DATA KRX6( 1 ) / 0 / +c$$$ +c$$$ DATA KRX7( 1 ) / 0 / +c$$$ +c$$$ DATA ( NRXWM( IRXXN ), IRXXN = 1, NWM ) / / +c$$$ +c$$$ DATA ( NRXWW( IRXXN ), IRXXN = 1, NWW ) / / +c$$$ +c$$$ DATA ( NRXWO2( IRXXN ), IRXXN = 1, NWO2 ) / / +c$$$ +c$$$ DATA NRXWN2( 1 ) / 0 / +c$$$ +c$$$ DATA ( NRXWCH4( IRXXN ), IRXXN = 1, NWCH4 ) / / +c$$$ +c$$$ DATA ( NRXWH2( IRXXN ), IRXXN = 1, NWH2 ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 1 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 2 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 3 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 4 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 5 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 6 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 7 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 8 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 9 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 10 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 11 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 12 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRR( IRXXN, 13 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( RTDAT( 1,IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( RTDAT( 2,IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( RTDAT( 3,IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IRRFALL( IRXXN ), IRXXN = 1, NFALLOFF ) / / +c$$$ +c$$$ DATA ( RFDAT( 1,IRXXN ), IRXXN = 1, NFALLOFF ) / / +c$$$ +c$$$ DATA ( RFDAT( 2,IRXXN ), IRXXN = 1, NFALLOFF ) / / +c$$$ +c$$$ DATA ( RFDAT( 3,IRXXN ), IRXXN = 1, NFALLOFF ) / / +c$$$ +c$$$ DATA ( RFDAT( 4,IRXXN ), IRXXN = 1, NFALLOFF ) / / +c$$$ +c$$$ DATA ( RFDAT( 5,IRXXN ), IRXXN = 1, NFALLOFF ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 1 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 2 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 3 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 4 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 5 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 6 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 7 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 8 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 9 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( SC( IRXXN, 10 ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( NREACT( IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( NPRDCT( IRXXN ), IRXXN = 1, NRXNS ) / / +c$$$ +c$$$ DATA ( IPH( IRXXN,1 ), IRXXN = 1, NMPHOT ) / / +c$$$ +c$$$ DATA ( IPH( IRXXN,2 ), IRXXN = 1, NMPHOT ) / / +c$$$ +c$$$ DATA ( IPH( IRXXN,3 ), IRXXN = 1, NMPHOT ) / / +c$$$ +c$$$ DATA ( PHOTAB( IRXXN ), IRXXN = 1, NPHOTAB ) / / +c$$$ +c$$$ DATA ( RXLABEL( IRXXN ), IRXXN = 1, NRXNS ) / / + +C End of Mechanism Reactions, Rates, etc. DATA INCLUDE File ------------ diff --git a/models/CCTM/MECHS/CH4only/mech.def b/models/CCTM/MECHS/CH4only/mech.def new file mode 100755 index 0000000..43e5ab3 --- /dev/null +++ b/models/CCTM/MECHS/CH4only/mech.def @@ -0,0 +1,572 @@ + +! RCS file, release, date & time of last delta, author, state, [and locker] +! $Header: /project/yoj/arc/MECHS/src/cb05cl_ae5_aq/mech.def,v 1.2 2011/08/30 21:03:50 sjr Exp $ + +! what(1) key, module and SID; SCCS file; date and time of last delta: +! %W% %P% %G% %U% + +CB05CL_AE5_AQ + +! CB05CL Mechanism +! Created from cb4_plus_mech_012005.def.txt provided by Greg Yarwood on +! 01/20/2005 +! Modified by Golam Sarwar for CMAQ implementation: +! 1) Lines were reformatted to limit the lengths within 81 spaces +! 2) Modified labels of photolysis reactions (maximum length 16 characters) +! ACROLEIN_CBIVPLUS exceeded 16 characters; all CBIVPLUS have been changed +! to CBIV05 +! Photolysis data completely revised by Greg Yarwood on 02/11/05. Using a +! combination of SAPRC99 data and IUPAC 2004. No data found for PACD +! (perxoyacetic acid) so set to zero for now. +! Modified R2, R10, and R113 by Gary Whitten on 23 Feb ’05 to conform to better +! conform to CMAQ and original CB4 of Gery et al ’89. +! Modified R103 and R104 to be same as R88 and R89 due to inconsistencies in +! trends between IUPAC ’04 and NASA ’03 concerning PAN and PPN and due to the +! differences being within the error estimates. +! Gary Whitten fixed Rxn’s 123, 137, 149, 150, and added 156 on 25 March, 2005 +! Modified R65, OH + CO, rate constant to use the IUPAC 2005 expression for N2 +! as third body (M). Implicit assumption that O2 has the same collisional +! efficiency as N2. Greg Yarwood 07/12/05. +! +! Modified the rate constants for reactions of N2O5 with H2O (R19 and R20). +! Heterognenous reaction involving N2O5 is incorporated in the aerosol module. +! Rate constants for these two reactions are set to 0.0 in the gas phase mechanism. +! Golam Sarwar 07/26/2005 +! +! Modified by Golam Sarwar 7/26/2005 to include gaseous species that +! are necessary to link gas-phase chemistry to aerosol formation. +! New species added: +! SULAER: Gives amount of sulfuric acid produced +! TOLAER: Gives total amount of TOL reacted +! XYLAER: Gives total amount of XYL reacted +! CSLAER: Gives total amount of CSL reacted +! TERPAER: Gives total amount of monoterpenes reacted +! +! Golam Sarwar +! 12/21/2005: Chlorine extension mechanism provided by Greg Yarwood +! The extended chlorine mechanism was added to the CB05_AE4_AQ mechanism +! +! Golam Sarwar +! 4/18/2006: Modified to use actual rate constant for RXN and +! +! Golam Sarwar +! 06/11/07: To maintain consistency with air toxics mechanism, added HCL + OH (CL21) +! Added HCL and OH reaction to more complete fate and transport modeling +! of HCL. The rate constant is based on Bryukov et. al (2006) in J. Chem. +! Phys. and is consistent with IUPAC 2004 recommendations. +! +! Golam Sarwar 10/22/07 +! Modified for incorporating SOA mechanism from Dr. Edward Edney +! Removed SULAER, TOLAER, XYLAER, CSLAER, TERPAER +! Added SULRXN, TOLRXN, XYLRXN, ISOPRXN, TRPRXN - counter species for aerosol from SO2, TOL, XYL, ISOPRENE, TERPENE +! Added one reaction for BENZENE with OH - rate constant is taken from SAPRC07 mechanism +! Added TOLRO2, XYLRO2, BENZRO2 - first generation products from TOL, XYL and BENZ that further react with NO and NO2 to produce SVOC +! Added two reactions for TOLRO2, added TOLNRXN, TOLHRXN - counter species for aerosol from TOL +! Added two reactions for XYLRO2, added XYLNRXN, XYLHRXN - counter species for aerosol from XYL +! Added two reactions for BENZRO2 added BNZNRXN, BNZHRXN - counter species for aerosol from BENZ +! Added three reactions for SESQ from sesquiterpene, added SESQRXN - counter species for aerosol from SESQ +! +! Modified by Golam Sarwar 11/19/2007 +! Revised photolysis rate of R96 from 0.0/ to 1.0/ +! based on email from Greg Yarwood 11/16/2007 +! +! Golam Sarwar 01/31/08 +! Added fixed concentrations for CH4, H2, N2, O2, and AIR for CMAQ use +! +! Golam Sarwar 03/31/08 +! Revised the coefficient of XO2 from 2.0 to 1.7 for reaction CL14 (agreed by Greg Yarwood) +! +! B.Hutzell 07/22/11 +! Set product cofficients for BENZRO2, TOLRO2 and XYLRO2 +!----------------------------------80 Characters Wide--------------------------- +REACTIONS[CM] = + +< R1> NO2 = NO + O # 1.0/; +< R2> O + O2 + M = O3 + M # 6.0E-34 ^ -2.4; +< R3> O3 + NO = NO2 # 3.0E-12 @ 1500.0; +< R4> O + NO2 = NO # 5.6E-12 @ -180.0; +< R5> O + NO2 = NO3 # 2.5E-31 ^-1.8 & + 2.2E-11 ^ -0.7; +< R6> O + NO = NO2 # 9.0E-32 ^ -1.5 & + 3.0E-11; +< R7> NO2 + O3 = NO3 # 1.2E-13 @ 2450; +< R8> O3 = O # 1.0/; +< R9> O3 = O1D # 1.0/; +< R10> O1D + M = O + M # 2.1E-11 @ -102.; +< R11> O1D + H2O = 2.000*OH # 2.2E-10; +< R12> O3 + OH = HO2 # 1.7E-12 @ 940; +< R13> O3 + HO2 = OH # 1.0E-14 @ 490; +< R14> NO3 = NO2 + O # 1.0/; +< R15> NO3 = NO # 1.0/; +< R16> NO3 + NO = 2.000*NO2 # 1.5E-11 @ -170; +< R17> NO3 + NO2 = NO + NO2 # 4.5E-14 @ 1260; +< R18> NO3 + NO2 = N2O5 # 2.0E-30 ^ -4.4 & + 1.4E-12 ^ -0.7; +< R19> N2O5 + H2O = 2.000*HNO3 # 2.5E-22; +< R20> N2O5 + H2O + H2O = 2.000*HNO3 # 1.8E-39; +< R21> N2O5 = NO3 + NO2 # 1.0E-03 ^-3.5 @ 11000 & + 9.7E+14 ^ 0.1 @ 11080 & + 0.45 & 1.0; +< R22> NO + NO + O2 = 2.000*NO2 # 3.3E-39 @ -530; +< R23> NO + NO2 + H2O = 2.000*HONO # 5.0E-40; +< R24> NO + OH = HONO # 7.0E-31 ^ -2.6 & + 3.6E-11 ^ -0.1; +< R25> HONO = NO + OH # 1.0/; +< R26> OH + HONO = NO2 # 1.8E-11 @ 390; +< R27> HONO + HONO = NO + NO2 # 1.0E-20; +< R28> NO2 + OH = HNO3 # 2.0E-30 ^ -3.0 & + 2.5E-11; +< R29> OH + HNO3 = NO3 %2 # 2.4E-14 @ -460 & + 2.7E-17 @ + -2199 & 6.5E-34 @ + -1335; +< R30> HO2 + NO = OH + NO2 # 3.5E-12 @ -250; +< R31> HO2 + NO2 = PNA # 1.8E-31 ^ -3.2 & + 4.7E-12 & 0.6; +< R32> PNA = HO2 + NO2 # 4.1E-5 @ 10650 & + 4.8E15 @ + 11170 & 0.6; +< R33> OH + PNA = NO2 # 1.3E-12 @ -380; +< R34> HO2 + HO2 = H2O2 %3 # 2.3E-13 @ -600 & + 1.7E-33 @ -1000; +< R35> HO2 + HO2 + H2O = H2O2 %3 # 3.22E-34 @ -2800 & + 2.38E-54 @ -3200; +< R36> H2O2 = 2.000*OH # 1.0/; +< R37> OH + H2O2 = HO2 # 2.9E-12 @ 160; +< R38> O1D + H2 = OH + HO2 # 1.1E-10; +< R39> OH + H2 = HO2 # 5.5E-12 @ 2000.; +< R40> OH + O = HO2 # 2.2E-11 @ -120.; +< R41> OH + OH = O # 4.2E-12 @ 240; +< R42> OH + OH = H2O2 # 6.9E-31 ^ -1.0 & + 2.6E-11 ^ 0; +< R43> OH + HO2 = # 4.8E-11 @ -250.; +< R44> HO2 + O = OH # 3.0E-11 @ -200.; +< R45> H2O2 + O = OH + HO2 # 1.4E-12 @ 2000.; +< R46> NO3 + O = NO2 # 1.0E-11; +< R47> NO3 + OH = HO2 + NO2 # 2.2E-11; +< R48> NO3 + HO2 = HNO3 # 3.5E-12; +< R49> NO3 + O3 = NO2 # 1.0E-17; +< R50> NO3 + NO3 = 2.000*NO2 # 8.5E-13 @ 2450.; +< R51> PNA = 0.610*HO2 + + 0.610*NO2 + + 0.390*OH + + 0.390*NO3 # 1.0/; +< R52> HNO3 = OH + NO2 # 1.0/; +< R53> N2O5 = NO2 + NO3 # 1.0/; +< R54> XO2 + NO = NO2 # 2.6E-12 @ -365; +< R55> XO2N + NO = NTR # 2.6E-12 @ -365; +< R56> XO2 + HO2 = ROOH # 7.5E-13 @ -700; +< R57> XO2N + HO2 = ROOH # 7.5E-13 @ -700; +< R58> XO2 + XO2 = # 6.8E-14; +< R59> XO2N + XO2N = # 6.8E-14; +< R60> XO2 + XO2N = # 6.8E-14; +< R61> NTR + OH = HNO3 + + HO2 + + 0.330*FORM + + 0.330*ALD2 + + 0.330*ALDX + - 0.660*PAR # 5.9E-13 @ 360.; +< R62> NTR = NO2 + + HO2 + + 0.330*FORM + + 0.330*ALD2 + + 0.330*ALDX + - 0.660*PAR # 1.0/; +< R63> ROOH + OH = XO2 + + 0.500*ALD2 + + 0.500*ALDX # 3.01E-12 @ -190; +< R64> ROOH = OH + + HO2 + + 0.500*ALD2 + + 0.500*ALDX # 1.0/; +< R65> OH + CO = HO2 %3 # 1.44E-13 @ 0.0 & + 3.43E-33 @ 0.0; +< R66> OH + CH4 = MEO2 # 2.45E-12 @ 1775; +< R67> MEO2 + NO = FORM + + HO2 + + NO2 # 2.8E-12 @ -300; +< R68> MEO2 + HO2 = MEPX # 4.1E-13 @ -750; +< R69> MEO2 + MEO2 = 1.370*FORM + + 0.740*HO2 + + 0.630*MEOH # 9.5E-14 @ -390; +< R70> MEPX + OH = 0.700*MEO2 + + 0.300*XO2 + + 0.300*HO2 # 3.8E-12 @ -200; +< R71> MEPX = FORM + + HO2 + + OH # 1.0/; +< R72> MEOH + OH = FORM + HO2 # 7.3E-12 @ 620; +< R73> FORM + OH = HO2 + CO # 9.0E-12; +< R74> FORM = 2.000*HO2 + CO # 1.0/; +< R75> FORM = CO # 1.0/; +< R76> FORM + O = OH + HO2 + CO # 3.4E-11 @ 1600; +< R77> FORM + NO3 = HNO3 + HO2 + CO # 5.8E-16; +< R78> FORM + HO2 = HCO3 # 9.7E-15 @ -625; +< R79> HCO3 = FORM + HO2 # 2.4E+12 @ 7000; +< R80> HCO3 + NO = FACD + NO2 + HO2 # 5.6E-12; +< R81> HCO3 + HO2 = MEPX # 5.6E-15 @ -2300; +< R82> FACD + OH = HO2 # 4.0E-13; +< R83> ALD2 + O = C2O3 + OH # 1.8E-11 @ 1100; +< R84> ALD2 + OH = C2O3 # 5.6E-12 @ -270; +< R85> ALD2 + NO3 = C2O3 + HNO3 # 1.4E-12 @ 1900; +< R86> ALD2 = MEO2 + CO + HO2 # 1.0/; +< R87> C2O3 + NO = MEO2 + NO2 # 8.1E-12 @ -270; +< R88> C2O3 + NO2 = PAN # 2.7E-28 ^ -7.1 & + 1.2E-11 ^ -0.9 & 0.3; +< R89> PAN = C2O3 + NO2 # 4.9E-3 @ 12100 & + 5.4E16 @ 13830 & 0.3; +< R90> PAN = C2O3 + NO2 # 1.0/; +< R91> C2O3 + HO2 = 0.800*PACD + + 0.200*AACD + + 0.200*O3 # 4.3E-13 @ -1040; +< R92> C2O3 + MEO2 = 0.900*MEO2 + + 0.900*HO2 + + FORM + + 0.100*AACD # 2.0E-12 @ -500; +< R93> C2O3 + XO2 = 0.900*MEO2 + + 0.100*AACD # 4.4E-13 @ -1070 ; +< R94> C2O3 + C2O3 = 2.000*MEO2 # 2.9E-12 @ -500; +< R95> PACD + OH = C2O3 # 4.0E-13 @ -200; +< R96> PACD = MEO2 + OH # 1.0/; +< R97> AACD + OH = MEO2 # 4.0E-13 @ -200; +< R98> ALDX + O = CXO3 + OH # 1.3E-11 @ 870; +< R99> ALDX + OH = CXO3 # 5.1E-12 @ -405; + ALDX + NO3 = CXO3 + HNO3 # 6.5E-15; + ALDX = MEO2 + CO + + HO2 # 1.0/; + CXO3 + NO = ALD2 + NO2 + + HO2 + XO2 # 6.7E-12 @ -340; + CXO3 + NO2 = PANX # 2.7E-28 ^ -7.1 & + 1.2E-11 ^ -0.9 & 0.3; + PANX = CXO3 + NO2 # 4.9E-3 @ 12100 & + 5.4E16 @ 13830 & 0.3; + PANX = CXO3 + NO2 # 1.0/; + PANX + OH = ALD2 + NO2 # 3.0E-13; + CXO3 + HO2 = 0.800*PACD + + 0.200*AACD + + 0.200*O3 # 4.3E-13 @ -1040; + CXO3 + MEO2 = 0.900*ALD2 + + 0.900*XO2 + + HO2 + + 0.100*AACD + + 0.100*FORM # 2.0E-12 @ -500; + CXO3 + XO2 = 0.900*ALD2 + + 0.100*AACD # 4.4E-13 @ -1070.; + CXO3 + CXO3 = 2.000*ALD2 + 2.000*XO2 + + 2.000*HO2 # 2.9E-12@-500; + CXO3 + C2O3 = MEO2 + XO2 + + HO2 + ALD2 # 2.9E-12@-500; + PAR + OH = 0.870*XO2 + + 0.130*XO2N + + 0.110*HO2 + + 0.060*ALD2 + - 0.110*PAR + + 0.760*ROR + + 0.050*ALDX # 8.1E-13; + ROR = 0.960*XO2 + + 0.600*ALD2 + + 0.940*HO2 + - 2.100*PAR + + 0.040*XO2N + + 0.020*ROR + + 0.500*ALDX # 1.E+15 @ 8000.; + ROR = HO2 # 1.6E+3; + ROR + NO2 = NTR # 1.5E-11; + O + OLE = 0.200*ALD2 + + 0.300*ALDX + + 0.300*HO2 + + 0.200*XO2 + + 0.200*CO + + 0.200*FORM + + 0.010*XO2N + + 0.200*PAR + + 0.100*OH # 1.E-11 @ 280.; + OH + OLE = 0.800*FORM + + 0.330*ALD2 + + 0.620*ALDX + + 0.800*XO2 + + 0.950*HO2 + - 0.700*PAR # 3.2E-11; + O3 + OLE = 0.180*ALD2 + + 0.740*FORM + + 0.320*ALDX + + 0.220*XO2 + + 0.100*OH + + 0.330*CO + + 0.440*HO2 + - 1.000*PAR # 6.5E-15 @ 1900.; + NO3 + OLE = NO2 + + FORM + + 0.910*XO2 + + 0.090*XO2N + + 0.560*ALDX + + 0.350*ALD2 + - 1.000*PAR # 7.0E-13 @ 2160.; + O + ETH = FORM + + 1.700*HO2 + + CO + + 0.700*XO2 + + 0.300*OH # 1.04E-11 @ 792; + OH + ETH = XO2 + + 1.560*FORM + + 0.220*ALDX + + HO2 # 1.0E-28 ^-0.8 & + 8.8E-12; + O3 + ETH = FORM + + 0.630*CO + + 0.130*HO2 + + 0.130*OH + + 0.370*FACD # 1.2E-14 @ 2630; + NO3 + ETH = NO2 + + XO2 + + 2.0*FORM # 3.3E-12 @ 2880.; + IOLE + O = 1.240*ALD2 + + 0.660*ALDX + + 0.100*HO2 + + 0.100*XO2 + + 0.100*CO + + 0.100*PAR # 2.3E-11; + IOLE + OH = 1.300*ALD2 + + 0.700*ALDX + + HO2 + + XO2 # 1.0E-11 @ -550.; + IOLE + O3 = 0.650*ALD2 + + 0.350*ALDX + + 0.250*FORM + + 0.250*CO + + 0.500*O + + 0.500*OH + + 0.500*HO2 # 8.4E-15 @ 1100.; + IOLE + NO3 = 1.180*ALD2 + + 0.640*ALDX + + HO2 + + NO2 # 9.6E-13 @ 270.; + TOL + OH = 0.440*HO2 + + 0.080*XO2 + + 0.360*CRES + + 0.560*TO2 + + 1.0*TOLRO2 # 1.8E-12 @ -355; + TO2 + NO = 0.900*NO2 + + 0.900*HO2 + + 0.900*OPEN + + 0.100*NTR # 8.1E-12; + TO2 = CRES + + HO2 # 4.2; + OH + CRES = 0.400*CRO + + 0.600*XO2 + + 0.600*HO2 + + 0.300*OPEN # 4.1E-11; + CRES + NO3 = CRO + HNO3 # 2.2E-11; + CRO + NO2 = NTR # 1.4E-11; + CRO + HO2 = CRES # 5.5E-12; + OPEN = C2O3 + + HO2 + + CO # 9.0/; + OPEN + OH = XO2 + + 2.000*CO + + 2.000*HO2 + + C2O3 + + FORM # 3.0E-11; + OPEN + O3 = 0.030*ALDX + + 0.620*C2O3 + + 0.700*FORM + + 0.030*XO2 + + 0.690*CO + + 0.080*OH + + 0.760*HO2 + + 0.200*MGLY # 5.4E-17 @ 500.; + OH + XYL = 0.700*HO2 + + 0.500*XO2 + + 0.200*CRES + + 0.800*MGLY + + 1.100*PAR + + 0.300*TO2 + + 1.0*XYLRO2 # 1.7E-11 @ -116.; + OH + MGLY = XO2 + C2O3 # 1.8E-11; + MGLY = C2O3 + + HO2 + + CO # 1.0/; + O + ISOP = 0.750*ISPD + + 0.500*FORM + + 0.250*XO2 + + 0.250*HO2 + + 0.250*CXO3 + + 0.250*PAR # 3.6E-11; + OH + ISOP = 0.912*ISPD + + 0.629*FORM + + 0.991*XO2 + + 0.912*HO2 + + 0.088*XO2N + + ISOPRXN # 2.54E-11 @ -407.6; + O3 + ISOP = 0.650*ISPD + + 0.600*FORM + + 0.200*XO2 + + 0.066*HO2 + + 0.266*OH + + 0.200*CXO3 + + 0.150*ALDX + + 0.350*PAR + + 0.066*CO # 7.86E-15 @ 1912; + NO3 + ISOP = 0.200*ISPD + + 0.800*NTR + + XO2 + + 0.800*HO2 + + 0.200*NO2 + + 0.800*ALDX + + 2.400*PAR # 3.03E-12 @ 448; + OH + ISPD = 1.565*PAR + + 0.167*FORM + + 0.713*XO2 + + 0.503*HO2 + + 0.334*CO + + 0.168*MGLY + + 0.252*ALD2 + + 0.210*C2O3 + + 0.250*CXO3 + + 0.120*ALDX # 3.36E-11; + O3 + ISPD = 0.114*C2O3 + + 0.150*FORM + + 0.850*MGLY + + 0.154*HO2 + + 0.268*OH + + 0.064*XO2 + + 0.020*ALD2 + + 0.360*PAR + + 0.225*CO # 7.1E-18; + NO3 + ISPD = 0.357*ALDX + + 0.282*FORM + + 1.282*PAR + + 0.925*HO2 + + 0.643*CO + + 0.850*NTR + + 0.075*CXO3 + + 0.075*XO2 + + 0.150*HNO3 # 1.0E-15; + ISPD = 0.333*CO + + 0.067*ALD2 + + 0.900*FORM + + 0.832*PAR + + 1.033*HO2 + + 0.700*XO2 + + 0.967*C2O3 # 0.0036/; + TERP + O = 0.150*ALDX + + 5.12*PAR + TRPRXN # 3.6E-11; + TERP + OH = 0.750*HO2 + + 1.250*XO2 + + 0.250*XO2N + + 0.280*FORM + + 1.66* PAR + + 0.470*ALDX + + TRPRXN # 1.5E-11 @ -449.; + TERP + O3 = 0.570*OH + + 0.070*HO2 + + 0.760*XO2 + + 0.180*XO2N + + 0.240*FORM + + 0.001*CO + + 7.000*PAR + + 0.210*ALDX + + 0.390*CXO3 + + TRPRXN # 1.2E-15 @ 821.; + TERP + NO3 = 0.470*NO2 + + 0.280*HO2 + + 1.030*XO2 + + 0.250*XO2N + + 0.470*ALDX + + 0.530*NTR + + TRPRXN # 3.7E-12 @ -175.; + SO2 + OH = SULF + HO2 + SULRXN # 3.0E-31 ^-3.3 & 1.5E-12; + OH + ETOH = HO2 + + 0.900*ALD2 + + 0.050*ALDX + + 0.100*FORM + + 0.100*XO2 # 6.9E-12 @ 230; + OH + ETHA = 0.991*ALD2 + + 0.991*XO2 + + 0.009*XO2N + + HO2 # 8.7E-12 @ 1070; + NO2 + ISOP = 0.200*ISPD + + 0.800*NTR + + XO2 + + 0.800*HO2 + + 0.200*NO + + 0.800*ALDX + + 2.400*PAR # 1.5E-19; + CL2 = 2.000*CL # 1.0/; + HOCL = OH + CL # 1.0/; + CL + O3 = CLO # 2.3E-11 @ 200; + CLO + CLO = 0.300*CL2 + 1.400*CL # 1.63E-14; + CLO + NO = CL + NO2 # 6.4E-12 @ -290; + CLO + HO2 = HOCL # 2.7E-12 @ -220; + OH + FMCL = CL + CO # 5.0E-13; + FMCL = CL + CO + HO2 # 1.0/; + CL + CH4 = HCL + MEO2 # 6.6E-12 @ 1240; + CL + PAR = HCL + + 0.870*XO2 + + 0.130*XO2N + + 0.110*HO2 + + 0.060*ALD2 + - 0.110*PAR + + 0.760*ROR + + 0.050*ALDX # 5.0E-11; + CL + ETHA = HCL + + 0.991*ALD2 + + 0.991*XO2 + + 0.009*XO2N + + HO2 # 8.3-11 @ 100; + CL + ETH = FMCL + + 2.000*XO2 + + 1.000*HO2 + + 1.000*FORM # 1.07E-10; + CL + OLE = FMCL + + 0.330*ALD2 + + 0.670*ALDX + + 2.000*XO2 + + 1.000*HO2 + - 1.000*PAR # 2.5E-10; + CL + IOLE = 0.300*HCL + + 0.700*FMCL + + 0.450*ALD2 + + 0.550*ALDX + + 0.300*OLE + + 0.300*PAR + + 1.700*XO2 + + 1.000*HO2 # 3.5E-10; + CL + ISOP = 0.15*HCL + + 1.000*XO2 + + 1.000*HO2 + + 0.850*FMCL + + 1.000*ISPD # 4.3E-10; + CL + FORM = HCL + + 1.000*HO2 + + 1.000*CO # 8.2E-11 @ 34; + CL + ALD2 = HCL + + 1.000*C2O3 # 7.9E-11; + CL + ALDX = HCL + + 1.000*CXO3 # 1.3E-10; + CL + MEOH = HCL + + 1.000*HO2 + + 1.000*FORM # 5.5E-11; + CL + ETOH = HCL + + 1.000*HO2 + + 1.000*ALD2 # 8.2E-11 @ -45; + HCL + OH = CL # 6.58E-13^1.16 @ -58; + TOLRO2 + NO = NO + TOLNRXN # 2.70e-12@-360; + TOLRO2 + HO2 = HO2 + TOLHRXN # 1.90e-13@-1300; + XYLRO2 + NO = NO + XYLNRXN # 2.70e-12@-360; + XYLRO2 + HO2 = HO2 + XYLHRXN # 1.90e-13@-1300; + BENZENE + OH = OH + 1.0*BENZRO2 # 2.47e-12@206; + BENZRO2 + NO = NO + BNZNRXN # 2.70e-12@-360; + BENZRO2 + HO2 = HO2 + BNZHRXN # 1.90e-13@-1300; + SESQ + O3 = O3 + SESQRXN # 1.16E-14; + SESQ + OH = OH + SESQRXN # 1.97E-10; + SESQ + NO3 = NO3 + SESQRXN # 1.90E-11; +END MECH + +CONSTANTS + ATM_AIR = 1.0E+06 + ATM_H2 = 0.56 + ATM_N2 = 0.7808E+06 + ATM_O2 = 0.2095E+06 + ATM_CH4 = 1.85 +END CONSTANTS diff --git a/models/CCTM/STENEX/swap_sandia_routines.f b/models/CCTM/STENEX/swap_sandia_routines.f index 25e4a0c..2c18ee3 100644 --- a/models/CCTM/STENEX/swap_sandia_routines.f +++ b/models/CCTM/STENEX/swap_sandia_routines.f @@ -233,10 +233,13 @@ subroutine swap4d(send,recv,n1,n2,n3,n4,dim1,dim2,dim3,dir) implicit none include 'mpif.h' -! real send(*) ! 1st value to be sent -! real recv(*) ! 1st value to be received - real send(:,:,:,:) ! 1st value to be sent - real recv(:,:,:,:) ! 1st value to be received +! The CMAQ release had an inversion of the send and recv code below commented out +! This was causing SEGSEGV and general memory issues when running with gfortran +! Fixed in commit fff90aaa26cb1fd6e413a752a52667d7b6dacdce + real send(*) ! 1st value to be sent + real recv(*) ! 1st value to be received +! real send(:,:,:,:) ! 1st value to be sent +! real recv(:,:,:,:) ! 1st value to be received integer n1,n2,n3,n4 ! # of values to send in each dim of 4d array integer dim1,dim2,dim3 ! 1st,2nd,3rd dimensions of 4d array integer dir ! direction to recv from: NSEW @@ -244,7 +247,7 @@ subroutine swap4d(send,recv,n1,n2,n3,n4,dim1,dim2,dim3,dir) integer i,j,k,l,m,n,ntotal,offset_ij,offset_jk,offset_kl integer recvproc,sendproc integer irequest,istatus(MPI_STATUS_SIZE),ierror -! real, allocatable :: rbuf(:),sbuf(:) + real, allocatable :: rbuf(:),sbuf(:) ntotal = n1*n2*n3*n4 offset_ij = dim1 - n1 @@ -254,66 +257,66 @@ subroutine swap4d(send,recv,n1,n2,n3,n4,dim1,dim2,dim3,dir) sendproc = sendneigh(dir) if (recvproc >= 0) then -! allocate(rbuf(ntotal)) -! call MPI_Irecv(rbuf,ntotal,MPI_REAL,recvproc,0,MPI_COMM_WORLD, - call MPI_Irecv(recv,ntotal,MPI_REAL,recvproc,0,MPI_COMM_WORLD, + allocate(rbuf(ntotal)) + call MPI_Irecv(rbuf,ntotal,MPI_REAL,recvproc,0,MPI_COMM_WORLD, +! call MPI_Irecv(recv,ntotal,MPI_REAL,recvproc,0,MPI_COMM_WORLD, $ irequest,ierror) endif if (sendproc >= 0) then -! allocate(sbuf(ntotal)) - -! m = 1 -! n = 1 - -! do l = 1,n4 -! do k = 1,n3 -! do j = 1,n2 -! do i = 1,n1 -! sbuf(n) = send(m) -! n = n + 1 -! m = m + 1 -! enddo -! m = m + offset_ij -! enddo -! m = m + offset_jk -! enddo -! m = m + offset_kl -! enddo -! -! call MPI_Send(sbuf,ntotal,MPI_REAL,sendproc,0,MPI_COMM_WORLD, - call MPI_Send(send,ntotal,MPI_REAL,sendproc,0,MPI_COMM_WORLD, + allocate(sbuf(ntotal)) + + m = 1 + n = 1 + + do l = 1,n4 + do k = 1,n3 + do j = 1,n2 + do i = 1,n1 + sbuf(n) = send(m) + n = n + 1 + m = m + 1 + enddo + m = m + offset_ij + enddo + m = m + offset_jk + enddo + m = m + offset_kl + enddo + + call MPI_Send(sbuf,ntotal,MPI_REAL,sendproc,0,MPI_COMM_WORLD, +! call MPI_Send(send,ntotal,MPI_REAL,sendproc,0,MPI_COMM_WORLD, $ ierror) -! deallocate(sbuf) + deallocate(sbuf) endif if (recvproc >= 0) then call MPI_Wait(irequest,istatus,ierror) -! -! m = 1 -! n = 1 - -! do l = 1,n4 -! do k = 1,n3 -! do j = 1,n2 -! do i = 1,n1 -! recv(m) = rbuf(n) -! n = n + 1 -! m = m + 1 -! enddo -! m = m + offset_ij -! enddo -! m = m + offset_jk -! enddo -! m = m + offset_kl -! enddo - -! deallocate(rbuf) -! + + m = 1 + n = 1 + + do l = 1,n4 + do k = 1,n3 + do j = 1,n2 + do i = 1,n1 + recv(m) = rbuf(n) + n = n + 1 + m = m + 1 + enddo + m = m + offset_ij + enddo + m = m + offset_jk + enddo + m = m + offset_kl + enddo + + deallocate(rbuf) + endif return diff --git a/models/CCTM/aero/aero_noop/AEROMET_DATA.F b/models/CCTM/aero/aero_noop/AEROMET_DATA.F new file mode 100755 index 0000000..e77da3d --- /dev/null +++ b/models/CCTM/aero/aero_noop/AEROMET_DATA.F @@ -0,0 +1,59 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/AEROMET_DATA.F,v 1.6 2012/01/19 13:10:03 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module aeromet_data + +C Some parameters and meteorological variables required in aerosol +C processing. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 renamed file and module from MET_DATA to AEROMET_DATA +C---------------------------------------------------------------------- + + Implicit None + +C Fundamental constants + Include SUBST_CONST ! common constants + + Real( 8 ), Parameter :: f6dpi = 6.0D0 / dpi + Real, Parameter :: f6pi = 6.0 / pi + Real( 8 ), Parameter :: dpi6 = dpi / 6.0D0 + Real, Parameter :: pi6 = pi / 6.0 + Real( 8 ), Parameter :: boltzmann = rgasuniv / avo ! [ J/K ] + +C Concentration lower limit used for gas species + Real, Parameter :: min_gasconc = 1.0E-30 ! [ ug/m^3 ] + +C Meteorological variables (data from MET_CRO_3D file) + Real :: airtemp ! air temp [ K ] + Real :: airpres ! air pressure [ Pa] + Real :: airdens ! air density [ kg/m^3] + Real :: airRH ! fractional relative humidity + Real :: airQV ! water vapor mass mixing ratio [ kg_H2O/kg_air ] + Real :: H2OsatVP ! saturation water vapor pressure [ Pa ] + Real :: H2OVP ! ambient water vapor pressure [ Pa ] + + End Module aeromet_data diff --git a/models/CCTM/aero/aero_noop/AERO_DATA.F b/models/CCTM/aero/aero_noop/AERO_DATA.F new file mode 100755 index 0000000..41a4ffe --- /dev/null +++ b/models/CCTM/aero/aero_noop/AERO_DATA.F @@ -0,0 +1,657 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/AERO_DATA.F,v 1.11 2011/10/21 16:10:02 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module aero_data + +C Defines aerosol species arrays and the parameters required in aerosol +C processing. +C +C Contains: +C Subroutine map_aero +C Subroutine extract_aero +C Subroutine update_aero +C Function findAero +C +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Inserted functionality of PMEM_DEFN +C -new subroutine map_pmemis +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C SH 04/04/11 Added sea-salt speciation factors +C +C---------------------------------------------------------------------- + + Implicit None + +C Number of aerosol species and modes + +C$$$ Integer, Parameter :: n_aerospc = 30 ! number of aero species + Integer, Parameter :: n_aerospc = 1 ! number of aero species + Integer, Parameter :: n_mode = 3 ! number of modes: + ! 1 = Aitken + ! 2 = accumulation + ! 3 = coarse + +C Define Logical values as T and F + Logical, Parameter, Private :: T = .true. + Logical, Parameter, Private :: F = .false. + + +C Default minimum concentration + Real, Parameter :: conmin = 1.0E-30 ! [ ug/m^3 ] + Real, Parameter :: conmin_set( n_mode ) = (/conmin, conmin, conmin/) + Real, Parameter :: conmin_so4( n_mode ) = (/1.0E-12,1.0E-6, conmin/) + Real, Parameter :: conmin_cor( n_mode ) = (/conmin, conmin, 1.889544E-05/) + + +C Flag to obtain coagulation coefficients +C by analytical approximation (True) or by Gauss-Hermite quadrature (False) + Logical, Parameter :: fastcoag_flag = .True. + +C------------------------------------------------------------------------------------------------------- + + Type spcs_type + Character( 16 ) :: name( n_mode ) ! names of aerosol species for each mode + Real :: min_conc( n_mode ) ! minimum concentration values for each mode + Real :: density ! density [ kg/m^3 ] + Logical :: no_M2Wet ! flag to exclude from 2nd moment during transport + Logical :: nonVol_soa ! non-volatile SOA flag + Logical :: tracer ! tracer flag; does have not mass + Integer :: charge ! electroneutrality charge + Real :: visual_idx ! visual index factor + Character( 16 ) :: optic_surr ! optical surrogate name + Character( 16 ) :: emis ! anthropogenic PM emissions names + Real :: emis_split( n_mode ) ! minimum concentration values for each mode + End Type spcs_type + + Type( spcs_type ), Parameter :: aerospc( n_aerospc ) = (/ +C nonVolSOA +C | Charge Emissions +C -----------Name-------------- NoM2Wet |Tracer| ----Split Factor---- +C Aitken Accum Coarse Min_Concs Density | | | | Visidx OptSurr Emis Aitken Accum Coarse +C --------- --------- --------- ---------- ------- + + + + ----- -------- -------- ------ ------ ------ +C$$$ & spcs_type((/'ASO4I ','ASO4J ','ASO4K '/),conmin_so4, 1800.0, F, F, F, -2, 3.0,'SOLUTE','PSO4 ',(/0.000,1.000,0.000/)), +C$$$ & spcs_type((/'ANO3I ','ANO3J ','ANO3K '/),conmin_set, 1800.0, F, F, F, -1, 3.0,'SOLUTE','PNO3 ',(/0.000,1.000,0.000/)), +C$$$ & spcs_type((/'ACLI ','ACLJ ','ACLK '/),conmin_set, 2200.0, F, F, F, -1, 0.0,'SOLUTE',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/'ANH4I ','ANH4J ','ANH4K '/),conmin_set, 1800.0, F, F, F, 1, 3.0,'SOLUTE',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/'ANAI ','ANAJ ','ANAK '/),conmin_set, 2200.0, F, F, F, 1, 0.0,'SOLUTE',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/'AORGPAI','AORGPAJ',' '/),conmin_set, 2000.0, F, F, F, 0, 4.0,'DUST ','POC ',(/0.001,0.999,0.000/)), +C$$$ & spcs_type((/'AECI ','AECJ ',' '/),conmin_set, 2200.0, F, F, F, 0, 10.0,'SOOT ','PEC ',(/0.001,0.999,0.000/)), + & spcs_type((/'AH2OI ','AH2OJ ','AH2OK '/),conmin_set, 1000.0, T, F, F, 0, 0.0,'WATER ',' ',(/0.000,0.000,0.000/))/) +C$$$ & spcs_type((/'A25I ','A25J ',' '/),conmin_set, 2200.0, F, F, F, 0, 1.0,'DUST ','PMFINE',(/0.000,1.000,0.000/)), +C$$$ & spcs_type((/' ','AALKJ ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AXYL1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AXYL2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AXYL3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATOL1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATOL2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATOL3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ABNZ1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ABNZ2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ABNZ3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATRP1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATRP2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AISO1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AISO2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AISO3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ASQTJ ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AOLGAJ ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AOLGBJ ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AORGCJ ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ',' ','ASOIL '/),conmin_set, 2600.0, F, F, F, 0, 0.0,'DUST ',' ',(/0.000,0.000,0.000/))/) +C$$$ & spcs_type((/' ',' ','ACORS '/),conmin_cor, 2200.0, F, F, F, 0, 0.0,'DUST ','PMC ',(/0.000,0.000,1.000/))/) + +C Sea-Salt Speciation factors +C NOTE: in SSEMIS.F, all sea-salt emissions are assumed to be in the accumulation +C and coarse modes + Real, Parameter :: aerospc_ssf( n_mode, n_aerospc) = Reshape ( +C Aitken Accum Coarse +C - ------ ------- ------- +C$$$ & (/ 0.0, 0.0755, 0.0755, ! ASO4 +C$$$ & 0.0, 0.0, 0.0, ! ANO3 +C$$$ & 0.0, 0.5389, 0.5389, ! ACL +C$$$ & 0.0, 0.0, 0.0, ! ANH4 +C$$$ & 0.0, 0.3856, 0.3856, ! ANA +C$$$ & 0.0, 0.0, 0.0, ! AORGPA +C$$$ & 0.0, 0.0, 0.0, ! AEC + & (/ 0.0, 0.0, 0.0 /), ! AH2O +C$$$ & 0.0, 0.0, 0.0, ! A25 +C$$$ & 0.0, 0.0, 0.0, ! AALK +C$$$ & 0.0, 0.0, 0.0, ! AXYL1 +C$$$ & 0.0, 0.0, 0.0, ! AXYL2 +C$$$ & 0.0, 0.0, 0.0, ! AXYL3 +C$$$ & 0.0, 0.0, 0.0, ! ATOL1 +C$$$ & 0.0, 0.0, 0.0, ! ATOL2 +C$$$ & 0.0, 0.0, 0.0, ! ATOL3 +C$$$ & 0.0, 0.0, 0.0, ! ABNZ1 +C$$$ & 0.0, 0.0, 0.0, ! ABNZ2 +C$$$ & 0.0, 0.0, 0.0, ! ABNZ3 +C$$$ & 0.0, 0.0, 0.0, ! ATRP1 +C$$$ & 0.0, 0.0, 0.0, ! ATRP2 +C$$$ & 0.0, 0.0, 0.0, ! AISO1 +C$$$ & 0.0, 0.0, 0.0, ! AISO2 +C$$$ & 0.0, 0.0, 0.0, ! AISO3 +C$$$ & 0.0, 0.0, 0.0, ! ASQT +C$$$ & 0.0, 0.0, 0.0, ! AOLGA +C$$$ & 0.0, 0.0, 0.0, ! AOLGB +C$$$ & 0.0, 0.0, 0.0, ! AORGC +C$$$ & 0.0, 0.0, 0.0 /), ! ASOIL +C$$$ & 0.0, 0.0, 0.0 /), ! ACORS + & (/ n_mode,n_aerospc /), Order = (/ 1,2 /) ) + +C Required species + Character( 16 ), Private, Parameter :: req_so4 = 'ASO4' + Character( 16 ), Private, Parameter :: req_nh4 = 'ANH4' + Character( 16 ), Private, Parameter :: req_no3 = 'ANO3' + Character( 16 ), Private, Parameter :: req_orgpa = 'AORGPA' + Character( 16 ), Private, Parameter :: req_na = 'ANA' + Character( 16 ), Private, Parameter :: req_cl = 'ACL' + Character( 16 ), Private, Parameter :: req_h2o = 'AH2O' + Character( 16 ), Private, Parameter :: req_soil = 'ASOIL' + Character( 16 ), Private, Parameter :: req_cors = 'ACORS' + +C Indexes of required species + Integer :: aso4_idx + Integer :: anh4_idx + Integer :: ano3_idx + Integer :: apoc_idx + Integer :: ana_idx + Integer :: acl_idx + Integer :: ah2o_idx + Integer :: asoil_idx + Integer :: acors_idx + +C Index required for compilation only, but not used in aero5 + Integer :: apncom_idx + +C Molecular weights and concentrations of aerosol species + Real :: aerospc_mw( n_aerospc ) ! aero species M.W. (from AE_SPC.EXT) [ g/mol ] + Real :: aerospc_conc( n_aerospc,n_mode ) ! aero species concentration [ ug/m^3 ] + +C Common factors + Real( 8 ) :: h2ofac ! converts mass concentrations [ug/m3] to 3rd moment concentrations [m3/m3] + +C------------------------------------------------------------------------------------------------------- + + Type mode_type + Character( 16 ) :: num_name ! name of aerosol number variable + Character( 16 ) :: srf_name ! name of aerosol surface area variable + Real :: min_numconc ! minimum number concentration + Real :: min_m2conc ! minimum 2nd moment concentration + Real :: min_m3conc ! minimum 3rd moment concentration + End Type mode_type + + Type ( mode_type ), Parameter :: aeromode( n_mode ) = (/ +C number surface minimum minimum minimum +C name name numconc m2conc m3conc +C ---------- ------- -------- ------- ------ + & mode_type('NUMATKN', 'SRFATKN', conmin, conmin, conmin), + & mode_type('NUMACC ', 'SRFACC ', conmin, conmin, conmin), + & mode_type('NUMCOR ', 'SRFCOR ', conmin, conmin, conmin)/) + + Real, Parameter :: min_sigma_g = 1.05 + Real, Parameter :: max_sigma_g = 2.50 + Real, Parameter :: def_sigma_g( n_mode ) = (/ 1.70, 2.0, 2.2 /) ! background sigma-G for each mode + Real, Parameter :: def_diam( n_mode ) = (/ 1.0E-8, 7.0E-8, 1.0E-6 /) ! background mean diameter for each mode + + Real :: moment0_conc( n_mode ) ! 0th moment concentration + Real :: moment2_conc( n_mode ) ! 2nd moment concentration + Real :: moment3_conc( n_mode ) ! 3rd moment concentration + +C Mass concentration (calculated by GETPAR) + Real :: aeromode_mass( n_mode ) ! [ ug/m^3 ] + +C Particle density (calculated by GETPAR) + Real :: aeromode_dens( n_mode ) ! [ kg/m^3 ] + +C Geometric mean diameter (calculated by GETPAR) + Real :: aeromode_diam( n_mode ) ! [ m ] + +C Log of geometric standard deviation (calculated by GETPAR ) + Real :: aeromode_sdev( n_mode ) + +C Minimum number (calculated in map_aero routine) + Real :: aeromode_minNum( n_mode ) = 1.e-30 + +C Minimum 2nd moment (calculated in map_aero routine) + Real :: aeromode_minM2( n_mode ) + +C Mapping for loading from and unloading to CGRID array + Integer :: aerospc_map( n_aerospc,n_mode ) ! indices of aero species to CGRID + Integer :: aeronum_map( n_mode ) ! indices of aero number variable to CGRID + Integer :: aerosrf_map( n_mode ) ! indices of aero surf area variable to CGRID + +C Emissions mapping + Integer :: n_emis_pm ! number of aerospc with emissions + Integer :: pmem_map( n_aerospc ) ! mapping to aerospc array for PM emissions + Character( 16 ) :: pmem_units ! units for PM emissions for all species + +C Private variables for loading from and unloading to CGRID array + Logical, Private, Save :: mapped = .False. + Character( 16 ), Private, Save :: pname = 'Aero_Data' + + Contains + +C----------------------------------------------------------------------- + Subroutine map_aero() + +C Defines aerosol mapping from CGRID for species concentration and moments. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Use cgrid_spcs ! CGRID mechanism species + Use aeromet_data + Use utilio_defn + + Implicit None + +C Local Variables: + Character( 80 ) :: xmsg + Integer m, n, spc + Real so4fac + Real anthfac + + if ( .Not. mapped ) Then + aerospc_mw = 0.0 + aerospc_map = 0 + +C build mapping to CGRID for each aero spc + Do m = 1, n_mode + Do spc = 1, n_aerospc + If ( aerospc( spc )%name( m ) .Ne. ' ' ) Then + n = index1( aerospc( spc )%name( m ), n_ae_spc, ae_spc ) + If ( n .Eq. 0 ) Then + xmsg = 'Species '// aerospc(spc)%name( m ) // ' in aerospc name is not in AE_SPC' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + aerospc_map( spc,m ) = ae_strt - 1 + n + If ( aerospc_mw( spc ) .Lt. 0.5 ) Then ! mw=0 means a new species + aerospc_mw( spc ) = ae_molwt( n ) + Else If ( aerospc_mw( spc ) .Ne. ae_molwt( n ) ) Then + xmsg = 'molecular weight of ' // Trim( aerospc( spc )%name( m ) ) + & // ' is different from that of the same species' + & // ' in the same or another mode.' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End If + End Do + End Do + +C Build mapping to CGRID for aero # and surf area variables + aeronum_map = 0 + aerosrf_map = 0 + + Do m = 1, n_mode + n = index1( aeromode( m )%num_name, n_ae_spc, ae_spc ) + If ( n .Eq. 0 ) Then + xmsg = 'Species ' // Trim( aeromode( m )%num_name ) + & //' in aeronum name is not in AE_SPC' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + Else + aeronum_map( m ) = ae_strt - 1 + n + End If + + n = index1( aeromode( m )%srf_name, n_ae_spc, ae_spc ) + If ( n .Eq. 0 ) Then + xmsg = 'species ' // Trim( aeromode( m )%srf_name ) + & // ' in aerosrf name is not in AE_SPC' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + Else + aerosrf_map( m ) = ae_strt - 1 + n + End If + End Do + +C Find indices of required species +C$$$ aso4_idx = findAero( req_so4, .True. ) +C$$$ anh4_idx = findAero( req_nh4, .True. ) +C$$$ ano3_idx = findAero( req_no3, .True. ) +C$$$ apoc_idx = findAero( req_orgpa, .True. ) +C$$$ ana_idx = findAero( req_na, .True. ) +C$$$ acl_idx = findAero( req_cl, .True. ) + ah2o_idx = findAero( req_h2o, .True. ) +C$$$ asoil_idx = findAero( req_soil, .True. ) +C$$$ acors_idx = findAero( req_cors, .True. ) + +C Compute common factors + h2ofac = 1.0D-9 * f6dpi / Real( aerospc( ah2o_idx )%density, 8 ) + +C compute aeromode_minNum and aeromode_minM2 +C$$$ so4fac = 1.0E-9 * f6dpi / aerospc( aso4_idx )%density +C$$$ anthfac = 1.0E-9 * f6dpi / aerospc( acors_idx )%density + + Do m = 1, n_mode +C$$$ If( m .Lt. n_mode ) Then +C$$$ aeromode_minNum( m ) = so4fac * aerospc( aso4_idx )%min_conc( m ) / +C$$$ & ( def_diam( m )**3 * Exp( 4.5 * Log( def_sigma_g( m ) )**2 ) ) +C$$$ Else +C$$$ aeromode_minNum( m ) = anthfac * aerospc( acors_idx )%min_conc(m) / +C$$$ & ( def_diam( m )**3 * Exp( 4.5 * Log( def_sigma_g( m ) )**2 ) ) +C$$$ End If + + aeromode_minM2( m ) = aeromode_minNum( m ) * def_diam(m)**2 * + & Exp( 2.0 * Log( def_sigma_g(m) )**2 ) + End do + + mapped = .True. + + End If ! Not mapped + + Return + End Subroutine map_aero + + +C----------------------------------------------------------------------- + Subroutine map_pmemis ( ) +C +C Set the emissions units from the header of EMIS_1 file +C verify that all the units are consistent + + Use utilio_defn + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + + ! Parameters: + Character( 10 ), Parameter :: blank10 = ' ' + + ! Local Variables: + Character( 16 ), Save :: pname = 'map_pmemis' + Character( 512 ) :: xmsg1 + Character( 1024 ) :: xmsg2 + Character( 10 ) :: units + + Integer :: indx + Integer :: v + Logical :: found + Logical :: match + + Logical, Save :: pm_mapped = .False. + +C only create mapping on first call + If ( pm_mapped ) Return + +C Call routine to map aerosol species array + If ( .Not. mapped ) Call map_aero ( ) + +C Open the gridded emissions file, which contains gas, aerosol, and non-reactive +C species + + If ( .Not. open3( emis_1, fsread3, pname ) ) Then + xmsg1 = 'Could not open '// emis_1 // ' file' + Call m3exit( pname, 0, 0, Trim( xmsg1 ), xstat1 ) + End If + + If ( .Not. desc3( emis_1 ) ) Then + xmsg1 = 'Could not get '// 'EMIS_1' // ' file description' + Call m3exit( pname, 0, 0, Trim( xmsg1 ), xstat2 ) + End If + +C Search emissions file for emission species names. Verify that their units +C are the same and set pmem_units + + n_emis_pm = 0 + pmem_units = 'null' + found = .True. + match = .True. + xmsg1 = 'Could not find the following species in emissions file' + xmsg2 = 'PM Units not uniform in EMIS_1 file.' + + Do v = 1, n_aerospc + If( aerospc( v )%emis .Ne. ' ' ) Then + n_emis_pm = n_emis_pm + 1 + pmem_map( n_emis_pm ) = v + + indx = index1( aerospc( v )%emis, nvars3d, vname3d ) + If ( indx .Le. 0 ) Then + xmsg1 = Trim( xmsg1 ) // crlf() // blank10 + & // Trim( aerospc( v )%emis ) + found = .False. + Cycle + End If + + ! change UNITS to upper case + units = units3d( indx ) + Call upcase( units ) + + !! save units on first emissions + If( pmem_units .Eq. 'null' ) pmem_units = units + + !! check that all emissions units match + If( pmem_units .Ne. units ) match = .False. + + !! build error message to use if mismatch + xmsg2 = Trim( xmsg2 ) // crlf() // blank10 + & // Trim( aerospc( v )%emis ) + & // '(' // Trim( units3d( indx ) ) // ')' + End If + End Do + +C if emission species not found throw error + If ( .Not. found ) Then + Call m3exit( pname, 0, 0, Trim( xmsg1 ), xstat2 ) + End If + +C if Units mismatch throw error + If ( .Not. match ) Then + Call m3exit( pname, 0, 0, Trim( xmsg2 ), xstat2 ) + End If + + pm_mapped = .True. + + Return + + End Subroutine map_pmemis + + +C----------------------------------------------------------------------- + Subroutine extract_aero( conc, minchk ) + +C Extracts the required aerosol data from CGRID into conc. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Implicit None + +C Arguments: + Real, Intent( In ) :: conc( : ) + Logical, Intent( In ) :: minchk + +C Local Variables: + Integer m, n, spc + + If ( .Not. mapped ) Then + Call map_aero() + End If + +C copy grid cell concentrations of aero species to aerospc_conc + aerospc_conc = 0.0 + If ( minchk ) Then + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .ne. 0 ) Then + aerospc_conc( spc,m ) = Max( conc( n ), aerospc( spc )%min_conc( m ) ) ! ug/m^3 + End If + End Do + End Do + Else + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .ne. 0 ) Then + aerospc_conc( spc,m ) = conc( n ) ! ug/m^3 + End If + End Do + End Do + End If + +C copy grid cell concentrations of aero # and surf area +C convert and assign to moment0_conc and moment2_conc + + moment0_conc = 0.0 + moment2_conc = 0.0 + + If ( minchk ) Then + Do m = 1, n_mode + n = aeronum_map( m ) + moment0_conc( m ) = Max( conc( n ), aeromode( m )%min_numconc ) + n = aerosrf_map( m ) + moment2_conc( m ) = Max( conc( n ), aeromode( m )%min_m2conc ) + End Do + Else + Do m = 1, n_mode + n = aeronum_map( m ) + moment0_conc( m ) = conc( n ) + n = aerosrf_map( m ) + moment2_conc( m ) = conc( n ) + End Do + End If + + Return + End Subroutine extract_aero + +C----------------------------------------------------------------------- + Subroutine update_aero( conc, minchk ) + +C Updates aerosol values in CGRID from the conc array. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Use aeromet_data !fundamental constants, data type definitions, etc. + Use utilio_defn + + Implicit None + +C arguments: + Real, Intent( Out ) :: conc( : ) + Logical, Intent( In ) :: minchk + +C local variables: + Character( 80 ) :: xmsg + Integer m, n, spc + + If ( .Not. mapped ) Then + xmsg = 'CGRID Species has not been mapped' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + +C Copy aerospc_conc back to grid cell concentrations + + If ( minchk ) Then + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .Ne. 0 ) Then + conc( n ) = Max( aerospc_conc( spc,m ), aerospc( spc )%min_conc( m ) ) + End If + End Do + End Do + Else + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .Ne. 0 ) Then + conc( n ) = aerospc_conc( spc,m ) + End If + End Do + End Do + End If + +C Copy aero number and surface area back to grid cell concentrations + + If ( minchk ) Then + Do m = 1, n_mode + n = aeronum_map( m ) + conc( n ) = Max( moment0_conc( m ), aeromode( m )%min_numconc ) + End Do + Else + Do m = 1, n_mode + n = aeronum_map( m ) + conc( n ) = moment0_conc( m ) + End Do + End If + + Do m = 1, n_mode + n = aerosrf_map( m ) + conc( n ) = pi * moment2_conc( m ) + End Do + + Return + End Subroutine update_aero + +C----------------------------------------------------------------------- + Integer Function findAero( vname, required ) Result ( idx ) + +C Finds the index of 'required' aerosol species in the aerospc list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Use utilio_defn + + Implicit None + +C Arguments: + Character( * ) :: vname + Logical :: required + +C Local Variables: + Character( 80 ) :: xmsg + Integer spc, n + + Do n = 1, n_mode + Do spc = 1, n_aerospc + If ( Index( aerospc( spc )%name( n ), Trim( vname ) ) .Gt. 0 ) Then + idx = spc + Return + End If + End Do + End Do + + If ( .Not. required ) Then + idx = 0 + Return + End If + + xmsg = 'Required Species ' // Trim( vname ) // ' Not found in aerospc names array' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + + Return + End Function findAero + + End Module aero_data + diff --git a/models/CCTM/aero/aero_noop/AERO_EMIS.F b/models/CCTM/aero/aero_noop/AERO_EMIS.F new file mode 100755 index 0000000..53eb5ed --- /dev/null +++ b/models/CCTM/aero/aero_noop/AERO_EMIS.F @@ -0,0 +1,865 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/AERO_EMIS.F,v 1.8 2011/10/21 16:10:02 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE AERO_EMIS + +C Emissions data and code required for the modal aerosol module in CMAQ +C Based on original codes by Dr. Francis S. Binkowski and J. Young + +C Dependent Upon: NONE + +C Revision History: + +C 30 Aug 01 J.Young: dyn alloc - Use HGRD_DEFN +C 09 Oct 03 J.Gipson: added MW array for AE emis species to module contents +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module, GRID_CONF +C 26 Apr 05 P.Bhave: removed code supporting the "old type" of emission +C files that had unspeciated PM10 and PM2.5 only +C removed need for 'AERO_SPC.EXT' by declaring the +C required variables locally +C 13 Jun 05 P.Bhave: added vars needed for sea-salt emission processing +C inherit N_AE_EMIS,AE_EMIS,AE_EMIS_MAP from AE_EMIS.EXT +C moved RHO* parameters from RDEMIS_AE to this module +C for use by SSEMIS routine +C 24 Aug 07 J.Young: Modified to enable in-line plume rise calculation for +C 3D pt source emissions. Distinguish between PM (primary, +C unspeciated, file data) and AE (model speciated). Re- +C named RDEMIS_AE to GET_AERO_EMIS. +C 11 Apr 08 J.Kelly: added code to emit coarse surface area +C 4 Jan 10 J.Young: restructure; eliminate ref to older AERO versions +C 21 Feb 10 J.Young: move sea salt emissions to its own module (SSEMIS) +C 23 Apr 10 J.Young: replace include files with mechanism namelists +C 30 Apr 10 J.Young: update to use aero_reeng by Steve Howard, Prakash Bhave, +C Jeff Young, and Sergey Napelenok +C 23 Jul 10 D.Wong: remove CLOSE3 and BARRIER +C 24 Feb 11 J.Young: Reorganized module with initialization and timestepping +C procedures +C 25 Mar 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C 04 Apr 11 S.Howard: Added mode dimension to SS_MAP array +C 11 May 11 D.Wong: incorporated twoway model implementation +C 18 Aug 11 David Wong: In the merge inline point source PM species calculation, +C arrays EMBUFF and PMEMIS_PT have incorrect index values + +C----------------------------------------------------------------------- + + USE AERO_DATA, ONLY: N_MODE + + IMPLICIT NONE + +C aerosol emissions: [ppmv/s] for mass & number spcs, [m2/mol/s] for surface area spcs + REAL, ALLOCATABLE, SAVE :: VDEMIS_AE( :,:,:,: ) + + INTEGER :: PM_EMLYRS ! number of vertical layers on emis file (set in EMIS_DEFN) + + PUBLIC VDEMIS_AE, PM_EMLYRS, AERO_EMIS_INIT, GET_AERO_EMIS + PRIVATE + +C Variables for converting mass emissions rate to number emissions rate + REAL, SAVE :: FACNUM( N_MODE ) + +C Variables for converting mass emissions rate to 2nd moment emissions rate + REAL, SAVE :: FACSRF( N_MODE ) + +C Variables for the thickness and volume of each grid cell + REAL, ALLOCATABLE, SAVE :: CELLHGT( : ) ! grid-cell height [sigma] + REAL, ALLOCATABLE, SAVE :: CELLVOL( : ) ! grid-cell volume [m2*sigma] + +C Emission rate of all aerosol species interpolated to current time + REAL, ALLOCATABLE, SAVE :: EMBUFF ( :,:,:,: ) ! in all grid cells + REAL, ALLOCATABLE, SAVE :: PM_EM ( : ) ! in one grid cell + REAL, ALLOCATABLE, SAVE :: EM_RATE ( : ) ! + REAL, ALLOCATABLE, SAVE :: EM_PART ( :,: ) ! + INTEGER, ALLOCATABLE, SAVE :: EM_MAP ( :,: ) ! index in namelist table + REAL, ALLOCATABLE, SAVE :: EM_FAC ( :,: ) ! Namelist emissions scaling factor + INTEGER, ALLOCATABLE, SAVE :: NUM_MAP ( : ) ! + REAL, ALLOCATABLE, SAVE :: NUM_FAC ( : ) ! + INTEGER, ALLOCATABLE, SAVE :: SRF_MAP ( : ) ! + REAL, ALLOCATABLE, SAVE :: SRF_FAC ( : ) ! + INTEGER, ALLOCATABLE, SAVE :: SS_MAP ( :,: ) ! + +C EMBUFF mass emission rate input global array +C PM_EM mass emission rate input localized to one grid cell +C EM_RATE scaled PM_EM +C EM_PART particulate mass emission rate in one grid cell +C EM_MAP mass emission rate index in VDEMIS_AE (CGRID) +C EM_FAC mass emission Namelist scaling factor for VDEMIS_AE (CGRID) +C NUM_MAP number emission rate index in VDEMIS_AE (CGRID) +C NUM_FAC +C SRF_MAP sfc area emission rate index in VDEMIS_AE (CGRID) +C SRF_FAC +C SS_MAP sea salt emission rate index in SSOUTM + +C Factor for converting aerosol emissions from input units ... + REAL, ALLOCATABLE, SAVE :: CONVEM_PM( : ) ! into [ug/m2/sec] + +C Variables for converting emission rates into molar-mixing-ratio units + REAL, PARAMETER :: GPKG = 1.0E+03 ! g/kg + REAL, PARAMETER :: MGPG = 1.0E+06 ! ug/g + +C Domain decomposition info from emission and meteorology files + INTEGER, SAVE :: STARTCOL, ENDCOL, STARTROW, ENDROW + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + +C For handling vapor-phase sulfuric acid emissions + INTEGER, SAVE :: VSULF ! index to H2SO4 in VDEMIS array + INTEGER, SAVE :: VPSO4 ! index to PSO4 in EM_RATE array + +C Miscellaneous variables + INTEGER :: IDX + CHARACTER( 96 ) :: XMSG = ' ' + INTEGER, SAVE :: LOGDEV + INTEGER, EXTERNAL :: SETUP_LOGDEV + + CONTAINS + +C----------------------------------------------------------------------- + FUNCTION AERO_EMIS_INIT ( JDATE, JTIME, TSTEP, NEMIS_AE ) RESULT ( SUCCESS) + +C Revision History: + +C 30 Aug 01 J.Young: dynamic allocation - Use INTERPX +C 29 Jul 03 P.Bhave: added compatibility with emission files that contain +C PM10, PEC, POA, PNO3, PSO4, and PMF, but do not +C contain PMC +C 20 Aug 03 J.Young: return aero emissions in molar mixing ratio, ppm units +C 09 Oct 03 J.Gipson: added MW array for AE emis species to module contents +C 01 Sep 04 P.Bhave: changed MW for primary organics from 120 to 220 g/mol, +C to match MWPOA in subroutine ORGAER3. +C 31 Jan 05 J.Young: dyn alloc - removed HGRD_ID, VGRID_ID, and COORD_ID +C include files because those parameters are now +C inherited from the GRID_CONF module +C 26 Apr 05 P.Bhave: removed code supporting the "old type" of emission +C files that had unspeciated PM10 and PM2.5 only +C removed need for 'AERO_CONST.EXT' by declaring the +C required variables locally +C simplified the CONVM, CONVN, CONVS calculations +C updated and enhanced in-line documentation +C 03 May 05 P.Bhave: fixed bug in the H2SO4 unit conversion, initially +C identified by Jinyou Liang of CARB +C 13 Jun 05 P.Bhave: calculate sea-salt emissions; execute if MECHNAME = AE4 +C read input fields from new OCEAN_1 file +C read extra input fields from MET_CRO_2D and MET_CRO_3D +C write diagnostic sea-salt emission file +C added TSTEP to call vector for diagnostic output file +C inherit MWs from AE_SPC.EXT instead of hardcoding +C find pointers to CGRID indices instead of hardcoding +C 08 Mar 07 P.Bhave& added capability for emission files that contain +C S.Roselle: POC or POA +C 30 Jan 08 P.Bhave: added compatibility with AE5 mechanisms +C 23 Mar 08 J.Young: modifications to allow for in-line point source emissions +C 11 Apr 08 J.Kelly: added code to emit coarse surface area +C 09 Sep 08 P.Bhave: backward compatibility with AE4 mechanisms +C 20 Feb 10 J.Young: move ssemis out to its own F90 module +C 25 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C 04 Apr 11 S.Howard: Reorganized SS_MAP as a 2-D array + +C References: +C CRC76, "CRC Handbook of Chemistry and Physics (76th Ed)", +C CRC Press, 1995 +C Hobbs, P.V. "Basic Physical Chemistry for the Atmospheric Sciences", +C Cambridge Univ. Press, 206 pp, 1995. +C Snyder, J.P. "Map Projections-A Working Manual", U.S. Geological Survey +C Paper 1395 U.S.GPO, Washington, DC, 1987. +C Binkowski & Roselle Models-3 Community Multiscale Air Quality (CMAQ) +C model aerosol component 1: Model Description. +C J. Geophys. Res., Vol 108, No D6, 4183 +C doi:10.1029/2001JD001409, 2003 +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain configuration + USE CGRID_SPCS ! CGRID mechanism species + USE SSEMIS ! sea-salt emissions + USE AERO_DATA + USE PRECURSOR_DATA + USE UTILIO_DEFN + + INCLUDE SUBST_RXCMMN ! to get mech name + INCLUDE SUBST_CONST ! physical and mathematical constants + 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 ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + INTEGER, INTENT( IN ) :: NEMIS_AE ! number of aerosol emissions species + LOGICAL SUCCESS + +C Local Variables: + +C Geometric mean diameter by volume (or mass) of emitted particles in +C each mode [ m ]. See paragraph #14 of Binkowski & Roselle (2003) + REAL, PARAMETER :: DGVEM( N_MODE ) = (/ 0.03E-6, 0.3E-6, 6.0E-6 /) + +C Geometric standard deviation of emitted particles in each mode, as +C described in paragraph #14 of Binkowski & Roselle (2003) + REAL, PARAMETER :: SGEM( N_MODE ) = (/ 1.7, 2.0, 2.2 /) + +C Variables for calculating the volume of each grid cell + REAL DX1, DX2 ! grid-cell width and length [m] + REAL CELLAREA ! grid-cell area [m2] + +C Factor for converting aerosol emissions from input units ... + REAL CONVEM_PM_MASS ! into [ug/sec] + +C Domain decomposition info from emission and meteorology files + INTEGER GXOFF, GYOFF ! origin offset + +C Miscellaneous variables + INTEGER STATUS ! ENV..., ALLOCATE status + CHARACTER( 16 ), SAVE :: PNAME = 'AERO_EMIS_INIT' + CHARACTER( 16 ) :: VNAME ! temp var for species names + INTEGER L, N, S ! Loop indices + +C ---------------------------------------------------------------------- + + LOGDEV = SETUP_LOGDEV() + +C *** Map data modules + CALL MAP_AERO() + CALL MAP_PRECURSOR() + CALL MAP_PMEMIS() + +C *** set up for sea-salt emission processing + IF ( .NOT. SSEMIS_INIT( JDATE, JTIME, TSTEP ) ) THEN + XMSG = 'Failure initializing sea-salt emission processing' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + END IF + + IF ( NEMIS_AE .GT. 0 ) THEN ! all EMLAYS + ALLOCATE ( VDEMIS_AE( NEMIS_AE,PM_EMLYRS,MY_NCOLS,MY_NROWS ), + & STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = 'VDEMIS_AE memory allocation failed' + CALL M3WARN ( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + VDEMIS_AE = 0.0 ! array assignment + END IF + +C *** Calculate factors for converting 3rd moment emission rates into number +C emission rates. See Equation 7b of Binkowski & Roselle (2003) + DO N = 1, N_MODE + FACNUM( N ) = EXP( 4.5 * LOG( SGEM( N ) ) ** 2 ) / DGVEM( N ) ** 3 + END DO + +C *** Calculate factors for converting 3rd moment emission rates into 2nd +C moment emission rates. See Equation 7c of Binkowski & Roselle (2003) + DO N = 1, N_MODE +! FACTM2( N ) = EXP( 0.5 * LOG( SGEM( N ) ) ** 2 ) / DGVEM( N ) + FACSRF( N ) = PI * EXP( 0.5 * LOG( SGEM( N ) ) ** 2 ) / DGVEM( N ) + END DO + +C *** Find location of sulfuric acid vapor in VDEMIS array + VNAME = 'SULF' + IDX = INDEX1 ( VNAME, N_GC_EMIS, GC_EMIS ) + IF ( IDX .NE. 0 ) THEN + VSULF = IDX ! index for vapor-phase H2SO4 emissions + ELSE + XMSG = 'Could not find ' // VNAME // 'in gas table' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + +C *** Allocate memory for PM_EM, EMBUFF, CELLHGT, CELLVOL, and CONVEM_PM + ALLOCATE ( PM_EM( N_EMIS_PM ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** PM_EM memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( EMBUFF( NCOLS,NROWS,PM_EMLYRS,N_EMIS_PM ), + & STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** EMBUFF memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( CONVEM_PM( PM_EMLYRS ), + & CELLHGT( PM_EMLYRS ), + & CELLVOL( PM_EMLYRS ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** CONVEM_PM, CELLHGT or CELLVOL memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Allocate memory for EM_RATE, EM_PART, EM_MAP, EM_FAC, NUM_MAP, NUM_FAC, SRF_MAP, SRF_FAC, and SS_MAP + ALLOCATE ( EM_RATE( N_EMIS_PM ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** EM_RATE memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( EM_PART( N_AEROSPC, N_MODE ), + & EM_MAP ( N_AEROSPC, N_MODE ), + & EM_FAC ( N_AEROSPC, N_MODE ), + & NUM_MAP( N_MODE ), + & NUM_FAC( N_MODE ), + & SRF_MAP( N_MODE ), + & SRF_FAC( N_MODE ), + & SS_MAP ( N_AEROSPC, N_MODE ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** memory allocation failed for ' + & // 'EM_PART, EM_MAP, EM_FAC, NUM_MAP, NUM_FAC, SRF_MAP, SRF_FAC, or SS_MAP' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Map indices of emission species + EM_MAP = 0 ! array assignment + EM_FAC = 1.0 ! array assignment ! array assignment + DO S = 1, N_AEROSPC + IF ( AEROSPC( S )%EMIS .NE. ' ' ) THEN + ! Verify that aerospc( S )%emis is a pm emis + DO N = 1, N_MODE + IF ( AEROSPC( S )%NAME( N ) .NE. ' ' ) THEN + EM_MAP( S,N ) = INDEX1( AEROSPC( S )%NAME( N ), N_AE_EMIS, AE_EMIS ) + EM_FAC( S,N ) = AE_EMIS_FAC( EM_MAP( S,N ) ) + END IF + END DO + END IF + END DO + +C *** Map aerosol number emission species + NUM_MAP = 0 + NUM_FAC = 1.0 ! array assignment + DO N = 1, N_MODE + NUM_MAP( N ) = INDEX1( AEROMODE( N )%NUM_NAME, N_AE_EMIS, AE_EMIS ) + NUM_FAC( N ) = AE_EMIS_FAC( NUM_MAP( N ) ) +#ifdef verbose1 + write( logdev,* ) 'num_map: ', n, num_map( n ), aeromode( n )%num_name, num_fac( n ) +#endif + IF ( NUM_MAP( N ) .EQ. 0 ) THEN + XMSG = 'Could not find ' // TRIM( AEROMODE( N )%NUM_NAME ) + & // ' in AE_EMIS table' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + END DO + +C *** Map aerosol surface emission species + SRF_MAP = 0 + SRF_FAC = 1.0 ! array assignment + DO N = 1, N_MODE + SRF_MAP( N ) = INDEX1( AEROMODE( N )%SRF_NAME, N_AE_EMIS, AE_EMIS ) + SRF_FAC( N ) = AE_EMIS_FAC( SRF_MAP( N ) ) +#ifdef verbose1 + write( logdev,* ) 'srf_map: ', n, srf_map( n ), aeromode( n )%srf_name, srf_fac( n ) +#endif + IF ( SRF_MAP( N ) .EQ. 0 ) THEN + XMSG = 'Could not find ' // TRIM( AEROMODE( N )%SRF_NAME ) + & // ' in AE_EMIS table' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + END DO + +C *** Map sea salt emission species + SS_MAP = 0 ! array assignment + DO S = 1, NSSSPC + IDX = SSSPC_MAP( S ) +#ifdef verbose1 + write( logdev,* ) 'ssspc_map: ', s, idx, ssspc_map( s ) +#endif + DO N = 2, N_MODE ! add SEASALT indices to EM_MAP + IF ( AEROSPC( IDX )%NAME( N ) .NE. ' ' ) THEN + EM_MAP( IDX,N ) = INDEX1( AEROSPC( IDX )%NAME( N ), N_AE_EMIS, AE_EMIS ) + SS_MAP( IDX,N ) = S +#ifdef verbose1 + write( logdev,* ) 'ss_map: ', s, n, idx, ss_map( idx,n ), aerospc( idx )%name( n ) +#endif + END IF + END DO + END DO + +#ifdef verbose1 + do s = 1, n_aerospc + do n = 1, n_mode + if ( em_map( s,n ) .ne. 0 ) then + write( logdev,* ) 'em_map: ', n, s, em_map( s,n ), aerospc( s )%name( n ), em_fac( s,n ) + end if + end do + end do +#endif + +C *** find index of SO4 emissions + VPSO4 = 0 + DO S = 1, N_EMIS_PM +! IF ( PMEM_MAP( S ) .EQ. ASO4_IDX ) VPSO4 = S + IF ( PMEM_MAP( S ) .EQ. ASO4_IDX ) THEN + VPSO4 = S +#ifdef verbose1 + write( logdev,* ) 'vpso4: ', s, pmem_map( s ), aso4_idx, vpso4 +#endif + END IF + END DO + + IF ( VPSO4 .EQ. 0 ) THEN + XMSG = 'Cannot define index for SO4 emissions: ' + & // 'aerospc%emis='' '' in AERO_DATA.F' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + +C *** Get length and width of each grid cell +C note: crude estimate is made for LAT/LONG coordinate systems + IF ( GDTYP_GD .EQ. LATGRD3 ) THEN + DX1 = DG2M * XCELL_GD ! in m + DX2 = DG2M * YCELL_GD + & * COS( PI180*( YORIG_GD + YCELL_GD + & * FLOAT( GL_NROWS/2 ) ) ) ! in m + ELSE + DX1 = XCELL_GD ! in m + DX2 = YCELL_GD ! in m + END IF + +C *** Get height of grid cell in each layer in sigma coordinates +C Multiply by grid area [m2] to obtain grid volume + CELLAREA = DX1 * DX2 + DO L = 1, PM_EMLYRS + CELLHGT( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) + CELLVOL( L ) = CELLHGT( L ) * CELLAREA + END DO + +C *** Get scaling factor for converting aerosol emissions from +C their input units to [ug/s] and then to [ug/m2/s] using layer- +C specific grid-cell volume. Calling DESC3( EMIS_1 ) assumes EMIS_1 +C already opened. + + IF ( PMEM_UNITS .EQ. 'G/S' .OR. + & PMEM_UNITS .EQ. 'g/s' ) THEN + CONVEM_PM_MASS = MGPG ! (g/s) -> (ug/s) + ELSE IF ( PMEM_UNITS .EQ. 'KG/HR' .OR. + & PMEM_UNITS .EQ. 'kg/hr' ) THEN + CONVEM_PM_MASS = GPKG * MGPG / 3600.0 ! (kg/hr) -> (ug/s) + ELSE + XMSG = 'Units incorrect on ' // EMIS_1 + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + END IF + + DO L = 1, PM_EMLYRS + CONVEM_PM( L ) = CONVEM_PM_MASS / CELLVOL( L ) + END DO + +C *** Get domain window info from input files + + CALL SUBHFILE ( EMIS_1, GXOFF, GYOFF, + & STARTCOL, ENDCOL, STARTROW, ENDROW ) + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + SUCCESS = .TRUE.; RETURN + + END FUNCTION AERO_EMIS_INIT + +C----------------------------------------------------------------------- + + SUBROUTINE GET_AERO_EMIS ( JDATE, JTIME, TSTEP, RJACM, VDEMIS ) + +C GET_AERO_EMIS reads PM emissions from gridded input file and +C optionally from plume rise calculated point source emissions (via VDEMIS +C array) and converts into molar-mixing-ratio units, for use in the vertical +C diffusion routines + +C Key Subroutines/Functions Called: SSEMIS_INIT, GET_SSEMIS, DUST_INIT, GET_DUST_EMIS + +C Revision History: + +C 18 Aug 11 David Wong: In the merge inline point source PM species calculation, +C arrays EMBUFF and PMEMIS_PT have incorrect index values + +C ---------------------------------------------------------------------- + USE GRID_CONF ! horizontal & vertical domain specifications + USE CGRID_SPCS ! CGRID mechanism species + USE PT3D_DEFN, ONLY: PT3DEMIS, PMEMIS_PT ! from plume rise + USE PTMAP, ONLY: N_SPC_PTPM, PTPM_MAP ! defines emissions file(s) PM mapping + USE AERO_DATA + USE PRECURSOR_DATA + USE SSEMIS ! sea-salt emissions + USE UTILIO_DEFN + + INCLUDE SUBST_CONST ! physical and mathematical constants + 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( 3 ) ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + ! TSTEP(2) = sciproc sync. step (chem) + ! TSTEP(3) = twoway model time step w.r.t. wrf time + ! step and wrf/cmaq call frequency + REAL, INTENT( IN ) :: RJACM( NCOLS,NROWS,NLAYS ) ! recip of mid-layer + ! Jacobian [1/m] + REAL, INTENT( INOUT ) :: VDEMIS( :,:,:,: ) ! gas emissions [ppmv/s] + +C Geometric Constants + REAL, PARAMETER :: F6DPI = 6.0 / PI + REAL, PARAMETER :: F6DPIM9 = 1.0E-9 * F6DPI ! 1.0E-9 = Kg/ug + +C flag when PMC is calc'd from PM10 +! Logical, Parameter :: PMCfromPM10 = .false. + +C Local variables for sea salt emission rates (grid cell value) + REAL :: CR_SSM( N_AEROSPC,N_MODE ) ! mass + REAL :: CR_SSN( N_MODE ) ! number + REAL :: CR_SSS( N_MODE ) ! surface area + + REAL( 8 ) :: GSFAC ! into [ug/m3/sec] + +C Variables interpolated from the meteorological input files + REAL DENS( NCOLS,NROWS,NLAYS ) ! air density [kg/m3] + +C Variables for converting emission rates into molar-mixing-ratio units + REAL, PARAMETER :: RAVO = 1.0 / AVO ! reciprocal of Avogadro + REAL( 8 ) :: CONVM ! conversion factor for mass emissions [m3/mol] + REAL( 8 ) :: CONVN ! conversion factor for number emissions [1e6*m3] + REAL( 8 ) :: CONVS ! conversion factor for surface area emissions [m3/mol] + +C Third moment emissions rates [m3/m3/s] + REAL( 8 ) :: EMISM3( N_MODE ) + +C Number emissions rates [1/m3/s] + REAL( 8 ) :: EM_NUM( N_MODE ) + +C Surface area emission rates [m2/m3/s] + REAL( 8 ) :: EM_SRF( N_MODE ) + +C Miscellaneous variables + CHARACTER( 16 ), SAVE :: PNAME = 'GET_AERO_EMIS' + INTEGER C, R, L, N, V, S ! Loop indices +! REAL( 8 ) :: FINETOT +#ifdef Verbose2 + real sumem +#endif + +C ---------------------------------------------------------------------- + +C *** Read aerosol emission rates from file and interpolate to the current +C time. Store result in EMBUFF array. + + IF ( PT3DEMIS ) THEN ! in-line plume rise + + EMBUFF = 0.0 ! array assignment + + DO S = 1, N_EMIS_PM ! read 2d file + IDX = PMEM_MAP( S ) + IF ( .NOT. INTERPX( EMIS_1, AEROSPC( IDX )%EMIS, PNAME, + & STARTCOL,ENDCOL, STARTROW,ENDROW, 1,1, + & JDATE, JTIME, EMBUFF( 1,1,1,S ) ) ) THEN + XMSG = 'Could not read ' + & // TRIM( AEROSPC( IDX )%EMIS ) // ' from ' // EMIS_1 + CALL M3WARN ( PNAME, JDATE, JTIME, XMSG ) + END IF + END DO + + DO S = 1, N_SPC_PTPM ! merge inline point src PM species + V = PTPM_MAP( S ) ! set in PT3D_DEFN + DO L = 1, PM_EMLYRS + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS +! EMBUFF( C,R,L,S ) = EMBUFF( C,R,L,S ) + PMEMIS_PT( C,R,L,V ) + EMBUFF( C,R,L,V ) = EMBUFF( C,R,L,V ) + PMEMIS_PT( C,R,L,S ) + END DO + END DO + END DO + END DO + + ELSE ! read 3d file + + DO S = 1, N_EMIS_PM + IDX = PMEM_MAP( S ) + IF ( .NOT. INTERPX( EMIS_1, AEROSPC( IDX )%EMIS, PNAME, + & STARTCOL,ENDCOL, STARTROW,ENDROW, 1,PM_EMLYRS, + & JDATE, JTIME, EMBUFF( 1,1,1,S ) ) ) THEN + XMSG = 'Could not read ' + & // TRIM( AEROSPC( IDX )%EMIS ) // ' from ' // EMIS_1 + CALL M3WARN ( PNAME, JDATE, JTIME, XMSG ) + END IF + END DO + + END IF + +C *** Read air density [kg/m3], atmospheric pressure [Pa], air temperature +C [K], specific humidity [kg H2O / kg air], and 10m wind speed [m/s] +C from meteorology file. Interpolate to the current time. Store results +C in DENS, PRES, TA, QV, and WSPD10 arrays. + IF ( .NOT. INTERPX( MET_CRO_3D, 'DENS', PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, + & 1,NLAYS, JDATE, JTIME, DENS ) ) THEN + XMSG = 'Could not interpolate DENS from ' // MET_CRO_3D + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Get sea salt emissions + CALL GET_SSEMIS ( JDATE, JTIME, TSTEP, + & CELLVOL( 1 ), RJACM( :,:,1 ), CELLHGT( 1 ) ) + +C *** Loop over each grid cell in layer 1 + + L = 1 + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +C *** Store aerosol emission rates for this grid cell in a 1D array + DO S = 1, N_EMIS_PM + PM_EM( S ) = EMBUFF( C,R,L,S ) + END DO + +C *** Get grid cell values for sea salt emission rates +C Convert units of SSOUTM from [g/m3/s] to [ug/m3/s]. + CR_SSM = 0.0 ! array assignment + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + IF ( SS_MAP( S,N ) .NE. 0 ) + & CR_SSM( S,N ) = SSOUTM( SS_MAP( S,N ),N,C,R ) * MGPG + END DO + CR_SSN( N ) = SSOUTN( N,C,R ) + CR_SSS( N ) = SSOUTS( N,C,R ) + END DO + +C *** Calculate scaling factor for converting mass emissions into [ug/m3/s] +C note: RJACM converts grid heights from sigma coordinates to meters +C Also calculate scaling factors for converting to molar-mixing-ratio units + GSFAC = CONVEM_PM( L ) * RJACM( C,R,L ) + CONVM = MWAIR / GPKG / DENS( C,R,L ) ! [m3/mol] + CONVN = CONVM * RAVO * 1.0E+06 ! 10^6 * [m3] + CONVS = CONVM ! [m3/mol] + +C *** Calculate speciated mass emission rates for fine aerosol [ug/m3/s] + DO S = 1, N_EMIS_PM + EM_RATE( S ) = PM_EM( S ) * GSFAC + END DO + +C *** If PMCfromPM10, the emission file did not contain PMC so +C PM_EM(VPMC) holds PM10 emissions. Substract the PM2.5 species +C from this so PM_EM(VPMC) holds only the coarse emission rate. +! IF ( PMCfromPM10 ) THEN +! FINETOT = 0.0 +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( 2 ) .GT. 0.0 ) +! & FINETOT = FINETOT + EM_RATE( S ) +! END DO +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( N_MODE ) .GT. 0.0 ) +! & EM_RATE( S ) = MAX( 0.0, EM_RATE( S ) - FINETOT ) +! END DO +! END IF + +C *** Extract H2SO4 vapor emission rate from the VDEMIS array, add it to +C the fine-PM sulfate emissions, and remove it from the gas emissions + EM_RATE( VPSO4 ) = EM_RATE( VPSO4 ) + VDEMIS( VSULF,L,C,R ) + & * PRECURSOR_MW( SULF_IDX ) / CONVM + VDEMIS( VSULF,L,C,R ) = 0.0 + +C *** Assign fine-particle emission rates to the fine modes. +C Assume all non-seasalt-emissions of sulfate, nitrate, and unspeciated +C fine PM are in the accumulation mode. Split the carbon emissions +C between the Aitken and accumulation modes, as described in paragraph +C #12 of Binkowski & Roselle (2003). + +C *** Calculate emissions rate for third moments [m3/m3/s] of each mode +C (excluding sea salt), as in Equation 7a of Binkowski & Roselle (2003). + + EM_PART = 0.0 ! array assignment + EMISM3 = 0.0 ! array assignment + DO S = 1, N_EMIS_PM + IDX = PMEM_MAP( S ) + DO N = 1, N_MODE + EM_PART( IDX,N ) = AEROSPC( IDX )%EMIS_SPLIT( N ) + & * EM_RATE( S ) + IF ( .NOT. AEROSPC( IDX )%TRACER ) THEN + EMISM3( N ) = EMISM3( N ) + EM_PART( IDX,N ) + & * ( F6DPIM9 / AEROSPC( IDX )%DENSITY ) + END IF + END DO + END DO + +C *** Calculate the number emissions rate for each mode [1/m3/s], using +C Equation 7b of Binkowski & Roselle (2003). + DO N = 1, N_MODE + EM_NUM( N ) = FACNUM( N ) * EMISM3( N ) + END DO + +C *** Calculate the surface area emissions rate for the fine modes [m2/m3/s], +C using Equation 7c of Binkowski & Roselle (2003). Multiplying by PI +C converts 2nd moment to surface area. + DO N = 1, N_MODE + EM_SRF( N ) = FACSRF( N ) * EMISM3( N ) + END DO + +C *** Units of CR_SSM are ug/m3/s]. Transfer Sea-salt mass emissions +C to mode- and species-specific variables. Sea-salt sulfate in the fine +C modes must be added to the anthropogenic sulfate emissions. Remaining +C sea-salt species are not in the standard inventory. + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + EM_PART( S,N ) = EM_PART( S,N ) + CR_SSM( S,N ) + END DO + END DO + +C *** Add sea salt to the total emissions of particle number and surface area + DO N = 1, N_MODE + EM_NUM( N ) = EM_NUM( N ) + CR_SSN( N ) + EM_SRF( N ) = EM_SRF( N ) + CR_SSS( N ) + END DO + +C *** Convert emission rates into molar-mixing-ratio units, as required by +C the vertical diffusion routines. Mass and number emissions are converted +C to [ppmv/s]. Note: EM_PART has units of [ug/m3/s] and mol(s)/mol(air) is +C 1.0e6 ppmv; so 1.0e-6 ug/g cancels the 1.0e6 ppmv/[mol(s)/mol(air)]. +C Surface area emissions are converted to [m2/mol/s]. +C Save results in the VDEMIS_AE array. + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + IF ( EM_MAP( S,N ) .GT. 0 ) THEN + VDEMIS_AE( EM_MAP( S,N ),L,C,R ) = EM_PART( S,N ) * EM_FAC( S,N ) + & * ( CONVM / AEROSPC_MW( S ) ) + END IF + END DO + VDEMIS_AE( NUM_MAP( N ),L,C,R ) = EM_NUM( N ) * NUM_FAC( N ) * CONVN + VDEMIS_AE( SRF_MAP( N ),L,C,R ) = EM_SRF( N ) * SRF_FAC( N ) * CONVS + END DO + + END DO ! loop on MY_NCOLS + END DO ! loop on MY_NROWS + + DO L = 2, PM_EMLYRS + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +C *** Store aerosol emission rates for this grid cell in a 1D array + DO S = 1, N_EMIS_PM + PM_EM( S ) = EMBUFF( C,R,L,S ) + END DO + +C *** Calculate scaling factor for converting mass emissions into [ug/m3/s] +C note: RJACM converts grid heights from sigma coordinates to meters +C Also calculate scaling factors for converting to molar-mixing-ratio units + GSFAC = CONVEM_PM( L ) * RJACM( C,R,L ) + CONVM = MWAIR / GPKG / DENS( C,R,L ) ! [m3/mol] + CONVN = CONVM * RAVO * 1.0E+06 ! 10^6 * [m3] + CONVS = CONVM ! [m3/mol] + +C *** Calculate speciated mass emission rates for fine aerosol [ug/m3/s] + DO S = 1, N_EMIS_PM + EM_RATE( S ) = PM_EM( S ) * GSFAC + END DO + +C *** If PMCfromPM10, the emission file did not contain PMC so +C PM_EM(VPMC) holds PM10 emissions. Substract the PM2.5 species +C from this so PM_EM(VPMC) holds only the coarse emission rate. +! IF ( PMCfromPM10 ) THEN +! FINETOT = 0.0 +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( 2 ) .GT. 0.0 ) +! & FINETOT = FINETOT + EM_RATE( S ) +! END DO +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( N_MODE ) .GT. 0.0 ) +! & EM_RATE( S ) = MAX( 0.0, EM_RATE( S ) - FINETOT ) +! END DO +! END IF + +C *** Extract H2SO4 vapor emission rate from the VDEMIS array, add it to +C the fine-PM sulfate emissions, and remove it from the gas emissions + EM_RATE( VPSO4 ) = EM_RATE( VPSO4 ) + VDEMIS( VSULF,L,C,R ) + & * PRECURSOR_MW( SULF_IDX ) / CONVM + VDEMIS( VSULF,L,C,R ) = 0.0 + +C *** Calculate emissions rate for third moments [m3/m3/s] of each mode +C (excluding sea salt), as in Equation 7a of Binkowski & Roselle (2003). + + EM_PART = 0.0 ! array assignment + EMISM3 = 0.0 ! array assignment + DO S = 1, N_EMIS_PM + IDX = PMEM_MAP( S ) + DO N = 1, N_MODE + EM_PART( IDX,N ) = AEROSPC( IDX )%EMIS_SPLIT( N ) + & * EM_RATE( S ) + IF ( .NOT. AEROSPC( IDX )%TRACER ) THEN + EMISM3( N ) = EMISM3( N ) + EM_PART( IDX,N ) + & * ( F6DPIM9 / AEROSPC( IDX )%DENSITY ) + END IF + END DO + END DO + +C *** Calculate the number emissions rate for each mode [1/m3/s], using +C Equation 7b of Binkowski & Roselle (2003). + DO N = 1, N_MODE + EM_NUM( N ) = FACNUM( N ) * EMISM3( N ) + END DO + +C *** Calculate the surface area emissions rate for the fine modes [m2/m3/s], +C using Equation 7c of Binkowski & Roselle (2003). Multiplying by PI +C converts 2nd moment to surface area. + DO N = 1, N_MODE + EM_SRF( N ) = FACSRF( N ) * EMISM3( N ) + END DO + +C *** Convert emission rates into molar-mixing-ratio units, as required by +C the vertical diffusion routines. Mass and number emissions are +C converted to [ppmv/s]. Surface area emissions are converted to +C [m2/mol/s]. Save results in the VDEMIS_AE array. + + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + IF ( EM_MAP( S,N ) .GT. 0 ) THEN + VDEMIS_AE( EM_MAP( S,N ),L,C,R ) = EM_PART( S,N ) * EM_FAC( S,N ) + & * CONVM / AEROSPC_MW( S ) + END IF + END DO + VDEMIS_AE( NUM_MAP( N ),L,C,R ) = EM_NUM( N ) * NUM_FAC( N ) * CONVN + VDEMIS_AE( SRF_MAP( N ),L,C,R ) = EM_SRF( N ) * SRF_FAC( N ) * CONVS + END DO + + END DO ! loop on MY_NCOLS + END DO ! loop on MY_NROWS + END DO ! loop on PM_EMLYRS + +#ifdef Verbose2 + write( logdev,'(/"@@@1",i8,i7.6)') jdate, jtime + l = 1 + do s = 1, n_ae_emis + sumem = 0.0 + do r = 1, my_nrows + do c = 1, my_ncols + sumem = sumem + vdemis_ae( s,l,c,r ) + end do + end do + write( logdev,'("@@@1 ",a,g16.6)') ae_emis( s ), sumem + end do +#endif + + RETURN + + END SUBROUTINE GET_AERO_EMIS + + END MODULE AERO_EMIS + diff --git a/models/CCTM/aero/aero_noop/PRECURSOR_DATA.F b/models/CCTM/aero/aero_noop/PRECURSOR_DATA.F new file mode 100755 index 0000000..feaa02a --- /dev/null +++ b/models/CCTM/aero/aero_noop/PRECURSOR_DATA.F @@ -0,0 +1,344 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/PRECURSOR_DATA.F,v 1.10 2012/01/19 13:11:38 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module precursor_data + +C Defines gas phase aerosol precursor data. + +C Contains: +C Subroutine extract_precursor +C Subroutine map_precursor +C Subroutine update_precursor +C Function findPrecursor + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C HS 03/10/11 Made OH a required species +C -added OH to "precursor" array (set rxncounter to .FALSE.); +C -added "update" column to precursor array to note which species +C concentrations will be affected by aerosol routines +C -added req_OH and OH_idx variables +C -changed precursor_conc to Real(8) + +C H.Pye 05/22/11: added ALK5RXN to precursor list for SAPRC mechanisms +C 08 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 + +C----------------------------------------------------------------------- + + Implicit None + + Integer, Parameter :: n_precursor = 19 ! # of precursors + + Type precursor_type + Character( 16 ) :: name ! species name + Logical :: rxncounter ! flag to reset counter species + Logical :: update ! update precursor concentration + ! in cgrid after aeroproc + End Type precursor_type + + Type ( precursor_type ), Private :: precursor( n_precursor ) = (/ +C Name RxnCounter Update +C ------- ---------- ------ + & precursor_type( 'NO2 ', .False. , .True. ), + & precursor_type( 'N2O5 ', .False. , .True. ), + & precursor_type( 'HNO3 ', .False. , .True. ), + & precursor_type( 'HONO ', .False. , .True. ), + & precursor_type( 'ISOPRXN', .True. , .True. ), + & precursor_type( 'TRPRXN ', .True. , .True. ), + & precursor_type( 'SULF ', .False. , .True. ), + & precursor_type( 'SULPRD ', .True. , .True. ), + & precursor_type( 'HCL ', .False. , .True. ), + & precursor_type( 'ALK5RXN', .True. , .True. ), + & precursor_type( 'TOLNRXN', .True. , .True. ), + & precursor_type( 'TOLHRXN', .True. , .True. ), + & precursor_type( 'XYLNRXN', .True. , .True. ), + & precursor_type( 'XYLHRXN', .True. , .True. ), + & precursor_type( 'BNZNRXN', .True. , .True. ), + & precursor_type( 'BNZHRXN', .True. , .True. ), + & precursor_type( 'SESQRXN', .True. , .True. ), + & precursor_type( 'NH3 ', .False. , .True. ), + & precursor_type( 'OH ', .False. , .False. ) /) + + +C Required species + Character( 16 ), Private, Parameter :: req_NO2 = 'NO2' + Character( 16 ), Private, Parameter :: req_N2O5 = 'N2O5' + Character( 16 ), Private, Parameter :: req_HNO3 = 'HNO3' + Character( 16 ), Private, Parameter :: req_HONO = 'HONO' + Character( 16 ), Private, Parameter :: req_SULF = 'SULF' + Character( 16 ), Private, Parameter :: req_SULPRD = 'SULPRD' + Character( 16 ), Private, Parameter :: req_HCL = 'HCL' + Character( 16 ), Private, Parameter :: req_NH3 = 'NH3' + Character( 16 ), Private, Parameter :: req_OH = 'OH' + +C Indices of required species + Integer :: NO2_idx + Integer :: N2O5_idx + Integer :: HNO3_idx + Integer :: HONO_idx + Integer :: SULF_idx + Integer :: SULPRD_idx + Integer :: HCL_idx + Integer :: NH3_idx + Integer :: OH_idx + + Real :: precursor_mw( n_precursor ) ! mol wt from cgrid_spcs [g/mol] + + Real( 8 ) :: precursor_conc( n_precursor ) ! precursor concentration [ug/m^3] + + Real :: so4rate ! sulfate gas-phase production rate [ug/m^3*s] + +C Private variables for loading and unloading to CGRID array + Integer :: precursor_map( n_precursor ) ! pointers to CGRID + Logical, Private, Save :: mapped = .False. + + Integer, Private, Save :: logdev + Integer, Private, External :: setup_logdev + + Contains + +C----------------------------------------------------------------------- + Subroutine map_precursor() + +C Defines mapping from CGRID for species concentration and moments. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C HS 03/10/11 Changed vtmp to real(8) +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C---------------------------------------------------------------------- + + Use cgrid_spcs ! CGRID mechanism species + Use utilio_defn + + Implicit None + +C Local Variables: + Character( 80 ) :: xmsg + Real( 8 ) :: vtmp + Integer :: n + Integer :: spc + + logdev = setup_logdev() + + precursor_mw = 0.0 + precursor_map = 0 + +C Build mapping to CGRID for each precursor species + Do spc = 1, n_precursor + n = index1( precursor( spc )%name, n_gc_g2ae, gc_g2ae ) + If ( n .Ne. 0 ) Then + precursor_mw( spc ) = gc_molwt( gc_g2ae_map( n ) ) + precursor_map( spc ) = gc_strt - 1 + gc_g2ae_map( n ) + Else + n = index1( precursor( spc )%name, n_nr_n2ae, nr_n2ae ) + If ( n .Ne. 0 ) Then + precursor_mw( spc ) = nr_molwt( nr_n2ae_map( n ) ) + precursor_map( spc ) = nr_strt - 1 + nr_n2ae_map( n ) + Else + xmsg = 'Species ' // Trim( precursor( spc )%name ) // + & ' in precursor name is not in GC_G2AE or NR_N2AE tables' +! Call m3exit( 'xtract_precursor', 0, 0, xmsg, xstat3 ) + Call m3warn( 'xtract_precursor', 0, 0, xmsg ) + End If + End If + End Do + +C Find indices of required species + NO2_idx = findPrecursor( req_NO2 ) + N2O5_idx = findPrecursor( req_N2O5 ) + HNO3_idx = findPrecursor( req_HNO3 ) + HONO_idx = findPrecursor( req_HONO ) + SULF_idx = findPrecursor( req_SULF ) + SULPRD_idx = findPrecursor( req_SULPRD ) + HCL_idx = findPrecursor( req_HCL ) + NH3_idx = findPrecursor( req_NH3 ) + OH_idx = findPrecursor( req_OH ) + +#ifdef verbose + Write( logdev,'( /5x, a )' ) 'map_precursor required species' + Write( logdev,'( 5x, a, i4 )' ) 'NO2_idx: ', NO2_idx + Write( logdev,'( 5x, a, i4 )' ) 'N2O5_idx: ', N2O5_idx + Write( logdev,'( 5x, a, i4 )' ) 'HNO3_idx: ', HNO3_idx + Write( logdev,'( 5x, a, i4 )' ) 'HONO_idx: ', HONO_idx + Write( logdev,'( 5x, a, i4 )' ) 'SULF_idx: ', SULF_idx + Write( logdev,'( 5x, a, i4 )' ) 'SULPRD_idx: ', SULPRD_idx + Write( logdev,'( 5x, a, i4 )' ) 'HCL_idx: ', HCL_idx + Write( logdev,'( 5x, a, i4 )' ) 'NH3_idx: ', NH3_idx + Write( logdev,'( 5x, a, i4 )' ) 'OH_idx: ', OH_idx +#endif + + mapped = .True. + + Write( logdev,'( 5x, a )' ) ' --- Precursor Species Mapped ---' + + Return + End Subroutine map_precursor + +C----------------------------------------------------------------------- + Subroutine extract_precursor( conc ) + +C Extracts the required precursor data from CGRID into conc. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C SH 03/10/11 Renamed met_data to aeromet_data +C HS 03/10/11 Changed vtmp and gasconv to real(8) +C----------------------------------------------------------------------- + + Use aeromet_data ! air and met variables + Use utilio_defn + + Implicit None + +C Arguments: + Real, Intent( In ) :: conc( : ) + +C Local Variables: + Real( 8 ) :: gasconv ! converts from [ppm] to [ug/m^3] + Real( 8 ) :: vtmp + Integer :: n + Integer :: spc + + If ( .Not. mapped ) Then + Call map_precursor() + End If + +C Compute gas conversion constant + gasconv = Real( airdens * 1.0E3 / mwair, 8 ) + +C Copy grid cell concentrations of precursor species + precursor_conc = 0.0 + + Do spc = 1, n_precursor + n = precursor_map( spc ) + If ( n .Ne. 0 ) Then + vtmp = gasconv * precursor_mw( spc ) + precursor_conc( spc ) = Max( conc( n ) * vtmp, min_gasconc ) + End If + End Do + + Return + End Subroutine extract_precursor + +C------------------------------------------------------------------------ + Subroutine update_precursor( conc ) + +C Updates CGRID aerosol precursor values from the conc array. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C SH 03/10/11 Renamed met_data to aeromet_data +C HS 03/10/11 Only update conc for species with "update" = .TRUE.; +C -changed vtmp and gasconv to real(8) +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use aeromet_data ! air and met variables + Use utilio_defn + + Implicit None + +C arguments: + Real, Intent( Out ) :: conc( : ) + +C local variables: + Character( 80 ) :: xmsg + Real( 8 ) :: gasconv ! converts from [ppm] to [ug/m^3] + Real( 8 ) :: vtmp + Integer :: n + Integer :: spc + + If ( .Not. mapped ) Then + xmsg = 'CGRID Species has not been mapped' + Call m3exit( 'update_precursor', 0, 0, xmsg, xstat3 ) + End If + +C compute gas conversion constant + gasconv = Real( airdens * 1.0E3 / mwair, 8 ) + +C copy precursor_conc back to grid cell concentrations + Do spc = 1, n_precursor + n = precursor_map( spc ) + If ( n .Ne. 0 ) Then + If ( precursor( spc )%update ) Then + If ( precursor( spc )%rxncounter ) Then + conc( n ) = 0.0 + Else + vtmp = precursor_mw( spc ) * gasconv + conc( n ) = Max( precursor_conc( spc ) / vtmp, min_gasconc ) + End If + End If + End If + End Do + + Return + End Subroutine update_precursor + +C----------------------------------------------------------------------- + Function findPrecursor( vname ) Result ( ndx ) + +C Finds the index of 'required' aerosol species in the precursor list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use utilio_defn + + Implicit None + +C Arguments: + Character( 16 ) :: vname + Integer ndx + +C Local Variables: + Integer :: spc + Character( 80 ) :: xmsg + + Do spc = 1, n_precursor + If ( Index( precursor( spc )%name, Trim( vname ) ) .Gt. 0 ) Then + ndx = spc + Return + End If + End Do + + xmsg = 'Required Species ' // Trim( vname ) + & // ' Not found in [precursor names] array' + Call m3exit( 'findPrecursor', 0, 0, xmsg, xstat3 ) + + Return + End Function findPrecursor + + End Module precursor_data diff --git a/models/CCTM/aero/aero_noop/SOA_DEFN.F b/models/CCTM/aero/aero_noop/SOA_DEFN.F new file mode 100755 index 0000000..4ee342e --- /dev/null +++ b/models/CCTM/aero/aero_noop/SOA_DEFN.F @@ -0,0 +1,1637 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/SOA_DEFN.F,v 1.9 2012/01/19 13:10:56 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module soa_defn + +C Defines aerosol species arrays and parameters required in SOA processing. + +C Contains: +C Subroutine extract_soa +C Subroutine update_soa +C Function findVapor +C Function findOrgprod +C Subroutine orgaer + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C HP 03/11/11 Updated monoterpene SOA alphas and Cstars to Carlton et al. 2010 values +C HP 07/24/11 Changed aromatic SOA alphas for consistency with updated reaction counters +C BNZ, TOL, XYL numbers now match Ng et al. 2007 Atmos. Chem. Phys. +C 08 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 +C 13 Aug 13 H. Pye: Xylene and toluene low-NOx yields switched. Values now +C follow experimental data of Ng et al. 2007 ACP as shown in Table 3. +C Values in Table 6 of Ng et al. (previously used) are incorrect. +C 18 Dec 13 G.Sarwar: added orgprod parent names based on RACM2 +C----------------------------------------------------------------------- + Implicit None + + Integer, Parameter :: n_vapor = 12 ! # of partitioning SVOCs + Integer, Parameter :: n_orgprod = 10 ! # of ROG rxn counter species + + Type vapor_type + Character( 16 ) :: name + Real :: alpha ! Mass-based stoichiometric coefficients [ug/m^3]/[ug/m^3] + Real :: cstar ! Effective saturation concentrations [ug/m^3] at 298 K + Real :: enth ! Enthalphy of Vaporization [J/mol] + Character( 16 ) :: soa_name ! Species name + Character( 1 ) :: soa_origin ! A = Anthropogenic; B = Biogenic + Real :: soa_decay ! Factor used in oligomerization + Character( 16 ) :: drog_name ! Precursor name + End Type vapor_type + + Type( vapor_type ), Parameter :: vaporspc( n_vapor ) = (/ +C Name Alpha CStar Enth SOA Decay Drog +C Name Origin Name +C ------- ------- -------- ------- ------ -- ---- ------- + & vapor_type('SV_ALK ', 0.0718, 0.0200, 40.0E3, 'AALKJ ', 'A', 8.0, 'ALK5RXN'), + & vapor_type('SV_XYL1', 0.0310, 1.3140, 32.0E3, 'AXYL1J', 'A', 8.0, 'XYLNRXN'), + & vapor_type('SV_XYL2', 0.0900, 34.4830, 32.0E3, 'AXYL2J', 'A', 8.0, 'XYLNRXN'), + & vapor_type('SV_TOL1', 0.0580, 2.3260, 18.0E3, 'ATOL1J', 'A', 7.0, 'TOLNRXN'), + & vapor_type('SV_TOL2', 0.1130, 21.2770, 18.0E3, 'ATOL2J', 'A', 7.0, 'TOLNRXN'), + & vapor_type('SV_BNZ1', 0.0720, 0.3020, 18.0E3, 'ABNZ1J', 'A', 6.0, 'BNZNRXN'), + & vapor_type('SV_BNZ2', 0.8880, 111.1100, 18.0E3, 'ABNZ2J', 'A', 6.0, 'BNZNRXN'), + & vapor_type('SV_TRP1', 0.1393, 14.7920, 40.0E3, 'ATRP1J', 'B', 10.0, 'TRPRXN '), + & vapor_type('SV_TRP2', 0.4542, 133.7297, 40.0E3, 'ATRP2J', 'B', 10.0, 'TRPRXN '), + & vapor_type('SV_ISO1', 0.2320, 116.0100, 40.0E3, 'AISO1J', 'B', 5.0, 'ISOPRXN'), + & vapor_type('SV_ISO2', 0.0288, 0.6170, 40.0E3, 'AISO2J', 'B', 5.0, 'ISOPRXN'), + & vapor_type('SV_SQT ', 1.5370, 24.9840, 40.0E3, 'ASQTJ ', 'B', 15.0, 'SESQRXN')/) + +C Required species + Character( 16 ), Private, Parameter :: req_sviso1 = 'SV_ISO1' + Character( 16 ), Private, Parameter :: req_sviso2 = 'SV_ISO2' + Character( 16 ), Private, Parameter :: req_aeiso1 = 'AISO1' + Character( 16 ), Private, Parameter :: req_aeiso2 = 'AISO2' + Character( 16 ), Private, Parameter :: req_aeiso3 = 'AISO3' + Character( 16 ), Private, Parameter :: req_aeolga = 'AOLGA' + Character( 16 ), Private, Parameter :: req_aeolgb = 'AOLGB' + Character( 16 ), Private, Parameter :: req_aeorgc = 'AORGC' + +C Indices of required species + Integer :: iso1_idx + Integer :: iso2_idx + Integer :: aiso1_idx + Integer :: aiso2_idx + Integer :: aiso3_idx + Integer :: aolga_idx + Integer :: aolgb_idx + Integer :: aorgc_idx + + Real :: vapor_mw ( n_vapor ) ! Molecular weights + Real :: vapor_conc( n_vapor ) ! vapor concentration + Integer :: drog_map ( n_vapor ) ! drog mapping assignments + +C orgprod species + + Type orgprod_type + Character( 16 ) :: name + Character( 16 ) :: parent + Character( 16 ) :: aerospc ! Non-volatile species name + Real :: alphaH ! Stoichiometric coefficients for non-volatile aromatic SOA [ug/m^3]/[ug/m^3] + End Type orgprod_type + +C This default orgprod table is for CB05, parent names are changed in subroutine +C extract_soa for the SAPRC99 and SAPRC07T mechanisms +C + Type( orgprod_type ), Save :: orgprod( n_orgprod ) = (/ +C Name Parent Aerospc AlphaH +C ------- ------- ------ ------ + & orgprod_type( 'ALK5RXN', 'ALK5RXN', ' ', 0.000 ), + & orgprod_type( 'XYLNRXN', 'XYL ', ' ', 0.000 ), + & orgprod_type( 'XYLHRXN', 'XYL ', 'AXYL3J', 0.360 ), + & orgprod_type( 'TOLNRXN', 'TOL ', ' ', 0.000 ), + & orgprod_type( 'TOLHRXN', 'TOL ', 'ATOL3J', 0.300 ), + & orgprod_type( 'BNZNRXN', 'BENZENE', ' ', 0.000 ), + & orgprod_type( 'BNZHRXN', 'BENZENE', 'ABNZ3J', 0.370 ), + & orgprod_type( 'TRPRXN ', 'TRPRXN ', ' ', 0.000 ), + & orgprod_type( 'ISOPRXN', 'ISOPRXN', ' ', 0.000 ), + & orgprod_type( 'SESQRXN', 'SESQRXN', ' ', 0.000 ) /) + + + Real :: orgprod_mw ( n_orgprod ) ! Mol weight of reactive organic gases + Real :: orgprod_conc ( n_orgprod ) ! orgprod concentration + Integer :: orgprod_aeroMap( n_orgprod ) ! orgprod pointers to aerospc + Integer :: soa_aeroMap ( n_vapor ) ! soa pointers to aerospc + +C mapping variables used for loading and unloading to CGRID array + Integer :: vapor_map( n_vapor ) ! pointers of vapor species to CGRID + Integer :: orgprod_map( n_orgprod ) ! pointers of orgprod species to CGRID + Logical, Private, Save :: mapped = .False. + + Character( 16 ), Private, Save :: pname = 'Soa_Defn ' + + Contains + +C----------------------------------------------------------------------- + Subroutine extract_soa( conc ) + +C Extracts the required soa data from CGRID into the conc array. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use aero_data ! aero species + Use aeromet_data ! air and met variables + Use cgrid_spcs ! CGRID mechanism species + Use utilio_defn + + Implicit None + +C Includes: + INCLUDE SUBST_RXCMMN ! to get mech name + +C Arguments: + Real, Intent( In ) :: conc( : ) + +C Local Variables: + Character( 80 ) :: xmsg + Real :: gasconv + Real :: vtmp + Integer :: n + Integer :: spc + + Real, Save :: alk_factor = 1.00 + + If ( .Not. mapped ) Then + + vapor_mw = 0.0 + vapor_map = 0 + +C Build mapping to CGRID for each vapor species + Do spc = 1, n_vapor + n = index1( vaporspc( spc )%name, n_nr_n2ae, nr_n2ae ) + If ( n .Ne. 0 ) Then + vapor_map( spc ) = nr_strt - 1 + nr_n2ae_map( n ) + vapor_mw( spc ) = nr_molwt( nr_n2ae_map( n ) ) + Else + xmsg = 'Species ' // Trim( vaporspc( spc )%name ) + & // ' in vapor name is not in non-reactives table' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End Do + +C define orgprod parent names based on mechanism dependence + If ( INDEX( MECHNAME, 'CB05' ) .EQ. 0 ) then + + If ( INDEX( MECHNAME, 'SAPRC99' ) .GT. 0 ) then + alk_factor = 0.57 ! fraction of ALK5 that can produce SOA + orgprod( 2 )%parent = 'ARO2' + orgprod( 3 )%parent = 'ARO2' + orgprod( 4 )%parent = 'ARO1' + orgprod( 5 )%parent = 'ARO1' + Else If ( INDEX( MECHNAME, 'SAPRC07T' ) .GT. 0 ) then + alk_factor = 0.57 ! fraction of ALK5 that can produce SOA + orgprod( 2 )%parent = 'MXYL' + orgprod( 3 )%parent = 'MXYL' + orgprod( 4 )%parent = 'TOLUENE' + orgprod( 5 )%parent = 'TOLUENE' + Else If( INDEX(MECHNAME, 'RACM2') .GT. 0) then + alk_factor = 0.57 ! fraction of ALK5 that can produce SOA + orgprod( 2 )%parent = 'XYM' + orgprod( 3 )%parent = 'XYM' + orgprod( 4 )%parent = 'TOL' + orgprod( 5 )%parent = 'TOL' + Else + xmsg = 'Mechanism ' // MECHNAME + & // ' is not supported in this version of the model' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + + End If ! non CB05 condition + + +C Build mapping to CGRID for each ORGPROD species and find MW of parent + + orgprod_map = 0 + Do spc = 1, n_orgprod + n = index1( orgprod( spc )%name, n_gc_g2ae, gc_g2ae ) + If ( n .Ne. 0 ) Then + orgprod_map( spc ) = gc_strt - 1 + gc_g2ae_map( n ) + n = index1( orgprod( spc )%parent, n_gc_spc, gc_spc ) + If ( n .Ne. 0 ) Then + orgprod_mw( spc ) = gc_molwt( n ) + Else + xmsg = 'Species ' // orgprod( spc )%parent + & // ' in ORGPROD parent name is not in gas species table' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End If + End Do + +C Find indices of required species + iso1_idx = findVapor( req_sviso1 ) + iso2_idx = findVapor( req_sviso2 ) + aiso1_idx = findAero( req_aeiso1, .True. ) + aiso2_idx = findAero( req_aeiso2, .True. ) + aiso3_idx = findAero( req_aeiso3, .True. ) + aolga_idx = findAero( req_aeolga, .True. ) + aolgb_idx = findAero( req_aeolgb, .True. ) + aorgc_idx = findAero( req_aeorgc, .True. ) + +C Build mapping array to aero species + soa_aeroMap = 0 + Do spc = 1, n_vapor + If ( vaporspc( spc )%soa_name .Ne. ' ' ) Then + soa_aeroMap( spc ) = findAero( vaporspc( spc )%soa_name, .True. ) + End If + End Do + + orgprod_aeroMap = 0 + Do spc = 1, n_orgprod + If ( orgprod( spc )%aerospc .Ne. ' ' ) Then + orgprod_aeroMap( spc ) = findAero( orgprod( spc )%aerospc, .True. ) + End If + End Do + +C Build mapping array to orgprod species + drog_map = 0 + Do spc = 1, n_vapor + If ( vaporspc( spc )%drog_name .Ne. ' ' ) Then + drog_map( spc ) = findOrgprod( vaporspc( spc )%drog_name ) + End If + End Do + + mapped = .True. + + End If ! mapping condition + +C Compute gas conversion constant + gasconv = airdens * 1.0E3 / mwair + +C Copy grid cell concentrations of vapor species + vapor_conc = 0.0 + + Do spc = 1, n_vapor + n = vapor_map( spc ) + If ( n .Ne. 0 ) Then + vtmp = gasconv * vapor_mw( spc ) + vapor_conc( spc ) = Max( conc( n ) * vtmp, min_gasconc ) + End If + End Do + +C Copy grid cell concentrations of ORGPROD species + orgprod_conc = 0.0 + Do spc = 1, n_orgprod + n = orgprod_map( spc ) + If ( n .Ne. 0 ) Then + orgprod_conc( spc ) = Max( conc( n ), min_gasconc ) + End If + End Do + +C Adjust ALK orgprod for fraction that produces SOA + orgprod_conc( 1 ) = alk_factor * orgprod_conc( 1 ) + + Return + End Subroutine extract_soa + +C----------------------------------------------------------------------- + Subroutine update_soa( conc ) + +C Populates CGRID from the conc array with updated SOA values. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use aeromet_data ! air and met variables + Use utilio_defn + + Implicit None + +C Arguments: + Real, Intent( Out ) :: conc( : ) + +C Local Variables: + Character( 80 ) :: xmsg + Real :: gasconv + Real :: vtmp + Integer :: n + Integer :: spc + + If ( .Not. mapped ) Then + xmsg = 'CGRID Species has not been mapped' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + +C Compute gas conversion constant + gasconv = airdens * 1.0E3 / mwair + +C Copy vapor_conc back to grid cell concentrations + Do spc = 1, n_vapor + n = vapor_map( spc ) + If ( n .Ne. 0 ) Then + vtmp = vapor_mw( spc ) * gasconv + conc( n ) = Max ( vapor_conc( spc ) / vtmp, min_gasconc ) + ! Write( *,'(a,i5,g16.6)' ) vaporspc( spc )%name, n, conc( n ) + End If + End Do + + Return + End Subroutine update_soa + +C----------------------------------------------------------------------- + Function findVapor( vname ) Result ( ndx ) + +C Finds the index of 'required' semivolatile species in the vaporspc list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use utilio_defn + + Implicit None + +C Arguments: + Character( 16 ) :: vname + Integer ndx + +C Local Variables: + Character( 80 ) :: xmsg + Integer :: spc + + Do spc = 1, n_vapor + If ( Trim( vaporspc( spc )%name ) .Eq. Trim( vname ) ) Then + ndx = spc + Return + End If + End Do + + xmsg = 'Required Species ' // Trim( vname ) // ' not found in [vapor names] array' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + + Return + End Function findVapor + +C----------------------------------------------------------------------- + Function findOrgprod( vname ) result ( ndx ) + +C Finds the index of 'required' organic product species in the orgprod list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use utilio_defn ! i/o api + + Implicit None + +C Arguments: + Character( 16 ) :: vname + Integer ndx + +C Local Variables: + Character( 80 ) :: xmsg + Integer :: spc + + Do spc = 1, n_orgprod + ! If ( Index( orgprod( spc )%name, Trim( vname ) ) .Gt. 0 ) Then + If ( Trim( orgprod( spc )%name ) .Eq. Trim( vname ) ) Then + ndx = spc + ! Write( *,'(a,i5)' ) vname, ndx + Return + End If + End Do + + xmsg = 'Required Species ' // Trim( vname ) + & // ' Not found in [orgprod names] array' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + + Return + End Function findOrgprod + +C----------------------------------------------------------------------- + Subroutine orgaer( dt, layer ) + +C Updates CGRID via several pathways for secondary organic aerosol (SOA) +C formation, as recommended by Edney et al. (2007). These include SOA +C formation from isoprene, monoterpenes, sesquiterpenes, long alkanes, and +C aromatics (incl. benzene). + +C Input includes the concentrations of reactive organic gases (ROG) +C that were oxidized during the time step (ORGPROD), the vapor-phase +C concentration of each semi-volatile organic compound, the +C concentration of each SOA species, and the concentration of primary +C organic aerosol (all concentrations are stored in the CBLK array). +C Output includes updated concentrations of SOA species, vapor-phase +C semi-volatile organic compounds, and moments of the accumulation +C mode. The geometric mean diameter of the accumulation mode is also +C updated. All SOA formation is restricted to the accumulation mode. + +C This code relies on 10 counter species to be incorporated in the +C gas-phase chemical mechanisms to track the amounts of individual +C ROG that reacted during the current time step (i.e., NPREC=10). +C The arrays of length = NPREC are ordered as follows: +C (1) "long" alkanes (ALKRXN) +C (2) low-yield aromatics, high-NOx pathway (XYLNRXN) +C (3) low-yield aromatics, low-NOx pathway (XYLHRXN) +C (4) high-yield aromatics, high-NOx pathway (TOLNRXN) +C (5) high-yield aromatics, low-NOx pathway (TOLHRXN) +C (6) benzene, high-NOx pathway (BNZNRXN) +C (7) benzene, low-NOx pathway (BNZHRXN) +C (8) monoterpenes (TRPRXN) +C (9) isoprene (ISOPRXN) +C (10) sesquiterpenes (SESQRXN) + +C In total, 12 organic species are allowed to partition between the +C vapor and particulate phases (i.e., NCVAP=12). The arrays of +C length = NCVAP are ordered as follows: +C (1) alkane (1 semi-volatile product) +C (2&3) low-yield aromatics, high-NOx pathway (2 products) +C (4&5) high-yield aromatics, high-NOx pathway (2 products) +C (6&7) benzene, high-NOx pathway (2 products) +C (8&9) monoterpenes (2 products) +C (10&11) isoprene (2 products) +C (12) sesquiterpenes (1 product) + +C Equilibrium partitioning calculations are based on the absorptive +C partitioning model of Pankow (1994) that was extended by Odum et +C al. (1996). Saturation vapor pressures (cstar) and mass-based +C stoichiometric yield coefficients (alpha) are obtained from smog- +C chamber studies. Saturation vapor pressures are modified as a +C function of temperature using eqn 6 of Sheehan & Bowman (2001). + +C If the pre-existing organic aerosol concentration is zero, +C gas/particle equilibrium is established only after the organic gas +C concentration reaches the threshold value defined in eqn 9 of +C Schell et al. (2001). Until this threshold value is reached, +C organic vapors do not partition to the particle phase. Once the +C organic gas/particle equilibrium has been established, gas and +C particle-phase concentrations of each condensible species are +C calculated iteratively using a globally convergent variation of +C Newton's method (SUBROUTINE NEWT), as described in eqn 8 of Schell +C et al. (2001). + +C In addition to the various pathways of semi-volatile SOA formation +C treated in previous versions of the model, four types of non- +C volatile SOA are considered here: +C (1) enhancement of isoprene-derived SOA under acidic conditions +C (2) aromatic-derived SOA under low-NOx conditions +C (3) oligomerization of all particle-phase semi-volatile material +C (4) SOA formed by in-cloud oxidation (SUBROUTINE AQCHEM) + +C Previous code revision history: +C Originally coded August 1, 2001 by Dr. Francis S. Binkowski + +C Revised April 4, 2003 by Gerald Gipson to allow for evaporation +C of organics from aerosols. Now total vapor + aerosol phase is +C repartitioned at each time step and totorgsw ( Mo ) does not +C include oldsoa. + +C Revised July 14, 2003 by Dr. Prakash V. Bhave +C - changed cstar(2,3) from 10.103 & 90.925 to 111.11 & 1000.0 +C because smog chamber data of Kalberer et al. were collected +C at 298 K (not 310 K, as was previously assumed) +C - changed mw_vap(9,10) from 184 g/mol to 177 g/mol, to be +C consistent with mwsoa_b +C - modified threshold criteria for establishing gas/particle +C equilibrium by removing the loose criterion involving "mtot" +C - changed variable names to reflect that the combined vapor + +C aerosol concentrations are now being repartitioned during +C each time step (not just the newly formed SVOC's) +C - added documentation and removed extraneous lines of code + +C Revised December 4, 2003 by Dr. Francis S. Binkowski +C - output variables ORGRATE and ORGBRATE removed and replaced +C by SOA_A and SOA_B, the newly equilibrated values of +C Anthropogenic and Biogenic SOA, respectively. These are non- +C negative values. +C - variable jj also removed + +C Revised January 8, 2004 by Dr. Prakash V. Bhave +C - removed the output variable YIELD. It has no physical meaning +C after the 12/04/2003 revisions. + +C Revised January 12, 2004 by Dr. Chris G. Nolte +C - for computational efficiency, modified the initial caer guess +C used as input to NEWT. If NEWT returns check .eq. true, then +C NEWT is called again with a guess of caer = 0.5*ctot +C - removed ITS parameter from NEWT call vector +C - fixed bug where concentrations less than TOLMIN (i.e., 1.0E-12) +C were reset to 1.0e-30 +C - removed extraneous code related to "Pandis method" of SVOC +C partitioning when threshold criterion is not met (i.e., +C insufficient organic matter to establish gas/particle +C equilibrium) ** results unaffected by this change +C +C Revised September 7, 2007 by Dr. Sergey L. Napelenok +C - Replaced old SOA species (SOA_A, SOA_B) with an array of +C precursor-specific SOA species. Replaced OLDSOA_A and OLDSOA_B +C with an array (OLDSOA). Updated call vector accordingly. +C - Deleted nole* and nbio* variables (now obsolete) +C - Increased the dimension of several arrays to accommodate new +C SOA precursors (benzene, sesquiterpenes) and pathways (low-NOx, +C acid-catalyzed, oligomers, in-cloud) +C +C Revised November 29, 2007 by Dr. Prakash V. Bhave +C - Renamed subroutine from ORGAER3 to ORGAER5 +C - Modified M2 and M3 calculations to account for the updated +C definition of DRY aerosol (which now includes non-volatile SOA) +C - Updated Hvap and corresponding cstar values +C - Added parameters for SOA from isoprene and sesquiterpenes +C - Updated aromatic SOA scheme to include semi-volatile and non- +C volatile products that form under high-NOx and low-NOx +C conditions, respectively +C - Added oligomerization process +C - Added enhancement of isoprene SOA under acidic conditions +C +C Revised June 2, 2008 by Dr. Prakash V. Bhave +C - Changed h_vap of benzene SOA to match that of toluene SOA, based +C on consultation with Dr. Ed Edney and Dr. Tad Kleindienst. + +C Revised June 5, 2008 by Drs. Prakash Bhave and Sergey Napelenok +C - Simplified the code for conserving low-volatility isoprene +C oxidation products and removed a minor bug in the acid-induced +C isoprene SOA calculation. +C +C Revised September 9, 2008 by Dr. Prakash V. Bhave +C - Increased alpha values for SV_TRP1, SV_TRP2, and SV_SQT by a +C factor of 1.3 to correct for the implicit assumption of unit +C density in those SOA yield parameters. +C - Reduced SOA/SOC ratio of AISO1 and AISO2 from 2.5 to 1.6, and +C increased SOA/SOC ratio of AISO3 from 2.5 to 2.7. Accordingly, +C the molar masses of AISO1 and AISO2 were decreased to 96 g/mol +C and the molar mass of AISO3 was increased to 162. + +C References: +C 1. Edney, E.O., T.E. Kleindienst, M. Lewandowski, and J.H. +C Offenberg, Updated SOA chemical mechanism for the Community +C Multi-Scale Air Quality model, EPA 600/X-07/025, U.S. EPA, +C Research Triangle Park, NC, 2007. + +C 2. Pankow, J. F., An absorption model of gas/particle partitioning +C of organic compounds in the atmosphere, Atmos. Environ., Vol 28, +C No 2, 185-188, 1994. + +C 3. Odum, J. R., T. Hoffmann, F. Bowman, D. Collins, R. C. Flagan, +C and J. H. Seinfeld, Gas/particle partitioning and secondary +C organic aerosol yields, Environ. Sci. Technol., Vol 30, No 8, +C 2580-2585, 1996. + +C 4. Sheehan, P. E. and F. M. Bowman, Estimated effects of temperature +C on secondary organic aerosol concentrations, Environ. Sci. +C Technol., Vol 35, No 11, 2129-2135, 2001. + +C 5. Schell, B., I. J. Ackermann, H. Hass, F. S. Binkowski, and +C A. Abel, Modeling the formation of secondary organic aerosol +C within a comprehensive air quality modeling system, J. Geophys. +C Res., Vol 106, No D22, 28275-28293, 2001. + +C 6. Strader, R., F. Lurmann, and S. N. Pandis, Evaluation of +C secondary organic aerosol formation in winter, Atmos. Environ., +C Vol 33, 4849-4863, 1999. + +C 7. Ng, N. L., J. H. Kroll, A. W. H. Chan, P. S. Chhabra, R. C. +C Flagan, and J. H. Seinfeld, Secondary organic aerosol formation +C from m-xylene, toluene, and benzene, Atmos. Chem. Phys., Vol 7, +C 3909-3922, 2007a. + +C 8. Griffin, R. J., D. R. Cocker III, R. C. Flagan, and J. H. +C Seinfeld, Organic aerosol formation from the oxidation of +C biogenic hydrocarbons, J. Geophys. Res., Vol 104, No D3, +C 3555-3567, 1999. + +C 9. Bian, F. and F. M. Bowman, Theoretical method for lumping +C multicomponent secondary organic aerosol mixtures, Environ. +C Sci. Technol., Vol 36, No 11, 2491-2497, 2002. + +C 10. Offenberg, J. H., T. E. Kleindienst, M. Jaoui, M. Lewandowski, +C and E. O. Edney, Thermal properties of secondary organic +C aerosols, Geophys. Res. Lett., Vol 33, L03816, doi:10.1029/ +C 2005GL024623, 2006. + +C 11. Bahreini, R., M. D. Keywood, N. L. Ng, V. Varutbangkul, S. Gao, +C R. C. Flagan, J. H. Seinfeld, D. R. Worsnop, and J. L. Jimenez, +C Measurements of secondary organic aerosol from oxidation of +C cycloalkenes, terpenes, and m-xylene using an Aerodyne aerosol +C mass spectrometer, Environ. Sci. Technol., Vol 39, 5674-5688, +C 2005. + +C 12. Alfarra, M. R., D. Paulsen, M. Gysel, A. A. Gaforth, J. Dommen, +C A. S. H. Prevot, D. R. Worsnop, U. Baltensperger, and H. Coe, +C A mass spectrometric study of secondary organic aerosols formed +C from the photooxidation of anthropogenic and biogenic precursors +C in a reaction chamber, Atmos. Chem. Phys., Vol 6, 5279-5293, +C 2006. + +C 13. Ng, N. L., P. S. Chhabra, A. W. H. Chan, J. D. Surratt, J. H. +C Kroll, A. J. Kwan, D. C. McCabe, P. O. Wennberg, A. Sorooshian, +C S. M. Murphy, N. F. Dalleska, R. C. Flagan, and J. H. Seinfeld, +C Effect of NOx level on secondary organic aerosol (SOA) formation +C from the photooxidation of terpenes, Atmos. Chem. Phys., Vol 7, +C 5159-5174, 2007b. + +C 14. Kostenidou, E., R. K. Pathak, and S. N. Pandis, An algorithm for +C the calculation of secondary organic aerosol density combining +C AMS and SMPS data, Aerosol Sci. Technol., Vol 41, 1002-1010, +C 2007. + +C 15. Offenberg, J. H., C. W. Lewis, M. Lewandowski, M. Jaoui, T. E. +C Kleindienst, and E. O. Edney, Contributions of toluene and +C alpha-pinene to SOA formed in an irradiated toluene/alpha-pinene/ +C NOx/air mixture: comparison of results using 14C content and SOA +C organic tracer methods, Environ. Sci. Technol., Vol 41, 3972- +C 3976, 2007. + +C 16. Henze, D. K. and J. H. Seinfeld, Global secondary organic aerosol +C from isoprene oxidation, Geophys. Res. Lett., Vol 33, L09812, +C doi:10.1029/2006GL025976, 2006. + +C 17. Kleindienst, T. E., M. Jaoui, M. Lewandowski, J. H. Offenberg, +C C. W. Lewis, P. V. Bhave, and E. O. Edney, Estimates of the +C contributions of biogenic and anthropogenic hydrocarbons to +C secondary organic aerosol at a southeastern US location, Atmos. +C Environ., Vol 41, 8288-8300, 2007. + +C 18. Kalberer, M., D. Paulsen, M. Sax, M. Steinbacher, J. Dommen, +C A. S. H. Prevot, R. Fisseha, E. Weingartner, V. Frankevich, +C R. Zenobi, and U. Baltensperger, Identification of polymers as +C major components of atmospheric organic aerosols, Science, Vol +C 303, 1659-1662, 2004. + +C 19. Turpin, B. J. and H.-J. Lim, Species contributions to PM2.5 mass +C concentrations: revisiting common assumptions for estimating +C organic mass, Aero. Sci. Technol., Vol 35, 602-610, 2001. + +C 20. Surratt, J. D., M. Lewandowski, J. H. Offenberg, M. Jaoui, T. E. +C Kleindienst, E. O. Edney, and J. H. Seinfeld, Effect of acidity +C on secondary organic aerosol formation from isoprene, Environ. +C Sci. Technol., Vol 41, 5363-5369, 2007. + +C Revision History: +C First orgaer version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + +C Key Subroutines/Functions called: newt + + Use aero_data + Use aeromet_data + Use utilio_defn + + Implicit None + +C Arguments: + Real :: dt ! Synchronization time step [ s ] + Integer :: layer ! model layer number + +C External functions: + Integer, External :: setup_logdev + +C Local variables: + Logical, Save :: first_time = .True. + Integer, Save :: logdev + Character( 80 ) :: xmsg + Integer :: i + + Real, Save :: mwpoa ! Molecular weight of POA [ g/mol ] + + Real, Save :: mw_vap_m1( n_vapor ) ! Inverse MW of SVOCs [ mol/g ] + + Real, Save :: drog_ppm2ug( n_orgprod ) ! [ ppm per ug/m3 ] for ORGPROD at + ! reference temperature and pressure + +C Parameters & variables for adjusting cstar to ambient conditions + Real, Parameter :: tref = 298.0 ! reference temperature [ K ] + Real, Parameter :: trefm1 = 1.0 / tref ! inverse of reference temperature + Real, Parameter :: prefm1 = 1.0 / stdatmpa ! inverse of reference pressure + Real, Parameter :: rgas1 = 1.0 / rgasuniv ! reciprocal of universal gas constant + Real, Parameter :: kolig = 0.69314718 / 72000.0 ! 20h half-life of oligomerization rate [ 1/s ] + Real, Parameter :: olgrat = 2.1 ! SOA/SOC ratio for oligomers + Real, Parameter :: kacid = 0.00361 ! acid-induced enhancement factor + Real, Parameter :: orgfac = 1.0E-9 * f6dpi / 2.0E3 + Real, Parameter :: convfac_298 = 101325.0 * rgas1 * trefm1 ! P/RT at 1 atm and 298 K [ mole/m**3 ] + + Real convfac + Real tt1, tt2 ! temperature-related factors + Real tempcorr ! temperature correction factor for cstar + +C Variables used in oligomerization calculations + Real expdt ! non-dimensional loss coefficient + Real nsvpa ! particle-phase anthropogenic SVOC [ umolC/m3 ] + Real nsvpb ! particle-phase biogenic SVOC [ umolC/m3 ] + +C Variables used in acid-enhanced isoprene SOA calculations + Real hplus ! accumulation-mode H+ conc [ nmol/m3 ] + Real aiso12 ! particle-phase isoprene SVOC [ ug/m3 ] + Real vviso ! vapor-phase isoprene SVOC [ ug/m3 ] + Real xiso3 ! newly produced AISO3J [ ug/m3 ] + Real isofrac ! ratio for depletion of vapor-phase products + +C Variables used in equilibrium partitioning calculations + Real drog( n_orgprod ) ! change in precursor conc [ ug/m3 ] + Real totrog( n_vapor ) ! drog conc mapped to each SVOC [ ug/m3 ] + Real c0 ( n_vapor ) ! cstar at AIRTEMP [ ug/m3 ] + Real ctoti ( n_vapor ) ! SVOC conc before current time step [ ug/m3 ] + Real prod ( n_vapor ) ! SVOC generated during current step [ ug/m3 ] + Real ctotf ( n_vapor ) ! SVOC conc after current time step [ ug/m3 ] + Real caer ( n_vapor ) ! SVOC conc in aerosol phase [ ug/m3 ] + Real totorgsw ! POA + non-volatile SOA [ umole/m3 ] + Real totorg ! SOA + POA before time step [ umole/m3 ] + Real threshold ! criterion for establishing gas/part equil. + Real, Parameter :: threshmin = 1.0E-19 ! small positive number + Real, Parameter :: ctolmin = 1.0E-06 + Logical check ! flag to indicate if NEWT subroutine + ! converged to a spurious root + +C Variables for updating 2nd and 3rd moments + Real old_m3 ! initial 3rd moment minus nonvol SOA [ mom/m3 ] + Real old_m2 ! initial 2nd moment minus nonvol SOA [ mom/m3 ] + Real new_m3 ! final 3rd moment with updated SOA [ mom/m3 ] + Real new_m2 ! final 2nd moment with updated SOA [ mom/m3 ] + +C----------------------------------------------------------------------- + + If ( first_time ) Then + first_time = .False. + logdev = setup_logdev() + +C Set unit conversion and inverse mw constants + + Do i = 1, n_orgprod + drog_ppm2ug( i ) = orgprod_mw( i ) * convfac_298 + End Do + + Do i = 1, n_vapor + mw_vap_m1( i ) = 1.0 / vapor_mw( i ) + End Do + + mwpoa = aerospc_mw( apoc_idx ) + + End If ! first_time + +C Compute 3rd moment, 2nd moment, and Dg without nonvolatile SOA. Cloud-produced +C SOA (i.e., orgcj) is not subtracted here because it is unchanged in this subroutine + old_m3 = moment3_conc( 2 ) + Do i = 1, n_aerospc + If ( aerospc( i )%nonVol_soa .And. i .Ne. aorgc_idx ) Then + old_m3 = old_m3 - orgfac * aerospc_conc( i,2 ) + End If + End Do + + old_m2 = moment2_conc( 2 ) * ( old_m3 / moment3_conc( 2 ) ) ** ( 2.0 / 3.0 ) + aeromode_diam( 2 ) = aeromode_diam( 2 ) * Sqrt( old_m2 / moment2_conc( 2 ) ) + +C Set temperature factors + tt1 = tref / airtemp + tt2 = trefm1 - 1.0 / airtemp + convfac = tt1 * airpres * prefm1 + +C Initialize drog from ORGPROD and change units to [ ug / m**3 ] + Do i = 1, n_orgprod + drog( i ) = orgprod_conc( i ) * drog_ppm2ug( i ) * convfac + end Do + +C Assignment of drog to totrog + Do i = 1, n_vapor + totrog( i ) = drog( drog_map( i ) ) + End Do + +C Transfer non-volatile products directly to aerospc_conc array (2nd mode) + Do i = 1, n_orgprod + If ( orgprod_aeroMap( i ) .Gt. 0 ) Then + aerospc_conc( orgprod_aeroMap( i ),2 ) = + & aerospc_conc( orgprod_aeroMap( i ),2 ) + & + orgprod( i )%alphaH * drog( i ) + End If + End Do + +C Oligomerization + +C Convert semi-volatile SOA to non-volatile oligomers by an exponential decay +C process that conserves carbon mass. + + nsvpa = 0.0 + nsvpb = 0.0 + + Do i = 1, n_vapor + If ( vaporspc( i )%soa_origin .Eq. 'A' ) + & nsvpa = nsvpa + aerospc_conc( soa_aeroMap( i ),2 ) + & * mw_vap_m1( i ) * vaporspc( i )%soa_decay + If ( vaporspc( i )%soa_origin .Eq. 'B' ) + & nsvpb = nsvpb + aerospc_conc( soa_aeroMap( i ),2 ) + & * mw_vap_m1( i ) * vaporspc( i )%soa_decay + End Do + + expdt = exp( - kolig * dt ) + + Do i = 1, n_vapor + aerospc_conc( soa_aeroMap( i ),2 ) = + & aerospc_conc( soa_aeroMap( i ),2 ) * expdt + End Do + + aerospc_conc( aolga_idx,2 ) = aerospc_conc( aolga_idx,2 ) + & + 12.0 * nsvpa * ( 1.0 - expdt ) * olgrat + aerospc_conc( aolgb_idx,2 ) = aerospc_conc( aolgb_idx,2 ) + & + 12.0 * nsvpb * ( 1.0 - expdt ) * olgrat + +C Compute molar concentrations of non-volatile organic material and total +C organic material; in future code updates, molecular weights of non-volatile +C SOA species should be inherited from the include files or namelists to avoid +C hard-coded values. + + totorgsw = ( aerospc_conc( apoc_idx,1 ) + aerospc_conc( apoc_idx,2 ) ) / mwpoa + Do i = 1, n_aerospc + If ( aerospc( i )%nonVol_soa ) Then + totorgsw = totorgsw + aerospc_conc( i,2 ) / aerospc_mw( i ) + End If + End Do + + totorg = totorgsw + Do i = 1, n_vapor + totorg = totorg + aerospc_conc( soa_aeroMap( i ),2 ) * mw_vap_m1( i ) + End Do + +C Initialize ctoti as sum of vapor-phase and particle-phase SVOCs +C Note: all of these CBLK species are in [ug/m**3] + Do i = 1, n_vapor + ctoti( i ) = vapor_conc( i ) + aerospc_conc( soa_aeroMap( i ),2 ) + End Do + +C Equilibrium Partitioning Calculations + +C Initial guess of caer is computed as follows: +C From eqn (8) of Schell et al. (2001) +C caer = ctotf - c0 * (caer/MW) / totorg +C Assuming totorg doesn't change during the timestep, +C caer * (1 + c0/MW / totorg) = ctotf +C caer = ctotf / ( 1 + c0/MW / totorg ) + + threshold = 0.0 + Do i = 1, n_vapor + tempcorr = tt1 * Exp( vaporspc( i )%enth * rgas1 * tt2 ) + c0( i ) = vaporspc( i )%cstar * tempcorr + prod( i ) = vaporspc( i )%alpha * totrog( i ) + ctotf( i ) = ctoti( i ) + prod( i ) + threshold = threshold + ctotf( i ) / c0( i ) + caer( i ) = ctotf( i ) * totorg ! initial + & / (totorg + c0( i ) * mw_vap_m1( i ) ) ! guess + End Do + +C Check If gas/particle equilibrium can be established + If ( ( threshold .Gt. 1.0 ) .Or. ( totorgsw .Gt. threshmin ) ) Then + +C Calculate new SOA by partitioning. This method uses a globally convergent +C Newton-Raphson method coded by Dr Benedikt Schell to solve the nonlinear +C quadratic system shown in eqn 8 of Schell et al: +C A(i) * caer(i) ** 2 + B * caer(i) + C(i) = 0.0, +C where B(i) contains the sum of all caer(j), for j not equal to i. + + Call newt( layer, caer, n_vapor, check, + & ctotf, c0, mw_vap_m1, totorgsw ) + If ( check ) Then +C Try again with initial guess of 50/50 gas/aerosol split. + Do i = 1, n_vapor + caer( i ) = 0.5 * ctotf( i ) + End Do + Call newt( layer, caer, n_vapor, check, + & ctotf, c0, mw_vap_m1, totorgsw ) + If ( check ) Then + Write( xmsg,'( A,I4 )' ) ' *** Problem in NEWT at Layer = ', layer + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End If + +C Constrain caer to values between conmin and ctotf + Do i = 1, n_vapor + + If ( caer( i ) .Lt. conmin ) Then + If ( caer( i ) .Lt. 0.0 ) Then + Write( logdev,* ) 'caer negative at i: ', i, caer( i ), + & ' reset to conmin' + End If + caer( i ) = conmin + End If + + If ( caer( i ) - ctotf( i ) .Gt. ctolmin ) Then + Write( logdev,* ) 'caer-ctotf exceeds ctolmin at i = ', i + Write( logdev,* ) 'caer: ', caer( i ), ' ctotf: ', ctotf( i ) + Write( logdev,* ) 'caer reset to ctotf' + caer( i ) = ctotf( i ) + End If + + End Do + + Else ! threshold not exceeded; no material transferred to aerosol phase + + caer = 0.0 ! array assignment + + End If ! check on equilibrium threshold + +C Transfer particle-phase SOA and vapor-phase SVOCs back to CBLK + Do i = 1, n_vapor + aerospc_conc( soa_aeroMap( i ),2 ) = caer( i ) + vapor_conc( i ) = ctotf( i ) - caer( i ) + End Do + +C Acid-induced Isoprene SOA + +C Particle-phase acidity is parameterized by the air concentration of hydrogen +C ion in the particle phase (hplus). This is computed by electroneutrality, +C and is bounded so that it cannot fall below zero (acid-neutral) nor above the +C range of experimental conditions (530 nmol/m3) tested by Surratt et al. +C (2007). In future code updates, molecular weights of inorganic ions should +C be inherited from include or namelist files to avoid hard-coded values. + + hplus = 0.0 + Do i = 1, n_aerospc + hplus = hplus - 1000.0 * aerospc( i )%charge * aerospc_conc( i,2 ) + & / aerospc_mw( i ) + End Do + hplus = Min( 530.0, Max ( 0.0, hplus ) ) ! restrict extrapolation + +C Compute amount of acid-enhanced isoprene SOA that is produced during the current +C time step (xiso3) using the normalized expression derived from Surratt et al. (2007) + + aiso12 = aerospc_conc( aiso1_idx, 2 ) + aerospc_conc( aiso2_idx, 2 ) + xiso3 = kacid * hplus * aiso12 - aerospc_conc( aiso3_idx,2 ) + +C Update CBLK(VISO3J) while conserving the total concentration of low-volatility +C isoprene-derived products. Since the acid-enhanced product is assumed to be +C non-volatile, only positive values of xiso3 are considered below. Also, xiso3 +C is not allowed to exceed the vapor-phase concentration of isoprene SVOC. We assume +C the xiso3 mass is depleted from the 2 vapor-phase isoprene products in quantities +C proportional to their equilibrium concentrations. The factor of 2.7/1.6 accounts +C for the enhancement in the OM/OC ratio when isoprene SOA is formed in the presence +C of SO2, based on the lab experiments of Kleindienst et al. (2007) + + If ( xiso3 .Gt. 0.0 ) Then + vviso = vapor_conc( iso1_idx ) + vapor_conc( iso2_idx ) + xiso3 = Min( xiso3, vviso ) + aerospc_conc( aiso3_idx,2 ) = aerospc_conc( aiso3_idx,2 ) + xiso3 * ( 2.7 / 1.6 ) + isofrac = vapor_conc( iso1_idx ) / vviso + vapor_conc( iso1_idx ) = vapor_conc( iso1_idx ) - isofrac * xiso3 + vapor_conc( iso2_idx ) = vapor_conc( iso2_idx ) - ( 1.0 - isofrac ) * xiso3 + End If + +C Update 3rd moment, 2nd moment, and Dg in CBLK array by assuming that SOA +C condensation/evaporation does not affect the geometric standard deviation. + + new_m3 = old_m3 + + Do i = 1, n_aerospc + If ( aerospc( i )%nonVol_soa .And. i .Ne. aorgc_idx ) Then + new_m3 = new_m3 + orgfac * aerospc_conc( i,2 ) + End If + End Do + + Do i = 1, n_vapor + new_m3 = new_m3 + orgfac * aerospc_conc( soa_aeroMap( i ),2 ) + End Do + + new_m2 = old_m2 * ( new_m3 / old_m3 ) ** ( 2.0 / 3.0 ) + + moment3_conc( 2 ) = new_m3 + moment2_conc( 2 ) = new_m2 + aeromode_diam( 2 ) = aeromode_diam( 2 ) * Sqrt( new_m2 / old_m2 ) + + Return + End Subroutine orgaer + +C----------------------------------------------------------------------- + SUBROUTINE NEWT( LAYER, X, N, CHECK, + & CTOT, CSAT, IMWCV, MINITW ) + +C Description: +C This subroutine and the underlying subprograms constitute Dr. +C Benedikt Schell's SOA model. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 9.7, 2nd ed. +C +C Given an initial guess X(1:N) for a root in N dimensions, find +C the root by a globally convergent Newton's method. The vector of +C functions to be zeroed, called FVEC(1:N) in the routine below, is +C returned by a user-supplied subroutine that must be called FUNCV +C and have the declaration SUBROUTINE FUNCV(N,X,FVEC). The output +C quantity CHECK is false on a normal return and true if the +C routine has converged to a local minimum of the function FMINV +C defined below. In this case, user should try restarting from a +C different initial guess. +C +C Key Subroutines Called: FDJAC, FMINV, LNSRCH, LUBKSB, LUDCMP +C +C Revision History: +C In CMAQ v4.3 - v4.7.1, this subroutine was embedded in a separate +C Fortran module entitled SOA_NEWT. Below, the Revision History from +C the SOA_NEWT module has been merged with the Revision History from +C this specific subroutine. +C +C CGN 01/12/04 removed ITS from call vector, added documentation, and +C removed extraneous lines of code +C +C SLN 09/18/07 updated NP and NPREC for compatibility with new SOA module +C +C PVB 11/19/07 renamed NP to NCVAP for consistency with ORGAER5 subroutine +C +C SH 02/10/10 embedded the old Fortran module, SOA_NEWT, into a new module, +C SOA_DEFN, so all SOA-related code can be found in one file. Renamed +C NCVAP to n_vapor. Its value is now set in SOA_DEFN (instead of inside +C this subroutine). Added TOLX to the call vector of Subroutine LNSRCH, +C since that parameter is now set in this subroutine (instead of in the +C Fortran module). +C +C References: +C 1. Schell, B., I. J. Ackermann, H. Hass, F. S. Binkowski, and +C A. Abel, Modeling the formation of secondary organic aerosol +C within a comprehensive air quality modeling system, J. Geophys. +C Res., Vol 106, No D22, 28275-28293, 2001. + + IMPLICIT NONE + +C Arguments + + INTEGER LAYER ! model layer + INTEGER N ! dimension of problem + REAL X( N ) ! initial guess of CAER + LOGICAL CHECK + REAL CTOT( N ) ! total concentration GAS + AER + PROD + REAL CSAT( N ) ! saturation conc. of cond. vapor [ug/m^3] + REAL IMWCV( N ) ! inverse molecular weights + REAL MINITW ! weighted initial mass + +C Following Numerical recipes + + Integer NN + REAL FVEC ! vector of functions to be zeroed + COMMON /NEWTV/ FVEC(n_vapor), NN + SAVE /NEWTV/ + +C Parameters + INTEGER, PARAMETER :: MAXITS = 100 ! maximum number of iterations + REAL, PARAMETER :: TOLF = 1.0E-09 ! convergence criterion on fxn values + REAL, PARAMETER :: TOLMIN = 1.0E-12 ! criterion whether spurious conver- + ! gence to a minimum has occurred + REAL, PARAMETER :: TOLX = 1.0E-10 ! convergence criterion on delta_x + REAL, PARAMETER :: STPMX = 100.0 ! scaled maximum step length allowed + +C Local variables + REAL CT + REAL CS + REAL IMW + REAL M + COMMON /NEWTINP/ CT( N_VAPOR ), CS( N_VAPOR ), IMW( N_VAPOR ), M + SAVE /NEWTINP/ + + INTEGER I, ITS, J, INDX( N_VAPOR ) + REAL D, DEN, F, FOLD, STPMAX, SUM, TEMP, TEST + REAL FJAC( N_VAPOR,N_VAPOR ) + REAL G( N_VAPOR), P( N_VAPOR ), XOLD( N_VAPOR ) +! EXTERNAL FDJAC + +C----------------------------------------------------------------------- + + CHECK = .FALSE. + M = MINITW + DO I = 1, N + CT( I ) = CTOT( I ) + CS( I ) = CSAT( I ) + IMW( I ) = IMWCV( I ) + END DO + + NN = N + CALL FMINV( X,F ) ! The vector FVEC is also computed by this call + TEST = 0.0 ! Test for initial guess being a root. Use more + ! stringent test than simply TOLF. + DO I = 1, N + IF ( ABS( FVEC( I ) ) .GT. TEST ) TEST = ABS( FVEC( I )) + END DO + + IF ( TEST .LT. 0.01 * TOLF ) RETURN ! initial guess is a root + SUM = 0.0 ! Calculate STPMAX for line searches + DO I = 1, N + SUM = SUM + X( I ) ** 2 + END DO + STPMAX = STPMX * MAX( SQRT( SUM ), FLOAT( N ) ) + DO ITS = 1, MAXITS ! start of iteration loop + CALL FDJAC( N, X, FJAC ) ! get Jacobian + DO I = 1, N ! compute Delta f for line search + SUM = 0.0 + DO J = 1, N + SUM = SUM + FJAC( J,I ) * FVEC( J ) + END DO + G( I ) = SUM + END DO + DO I = 1, N ! store X + XOLD( I ) = X( I ) + END DO + FOLD = F ! store F + DO I = 1, N ! right-hand side for linear equations + P( I ) = -FVEC( I ) + END DO + CALL LUDCMP( FJAC, N, INDX, D ) ! solve linear equations by LU decomposition + CALL LUBKSB( FJAC, N, INDX, P ) + CALL LNSRCH( CTOT, + & N, XOLD, FOLD, G, ! LNSRCH returns new X and F. It also + & P, X, F, STPMAX, ! calculates FVEC at the new X when it + & TOLX, CHECK ) ! calls FMINV + TEST = 0.0 + DO I = 1, N + IF ( ABS( FVEC( I ) ) .GT. TEST ) TEST = ABS( FVEC( I ) ) + END DO + IF ( TEST .LT. TOLF ) THEN + CHECK = .FALSE. + RETURN + END IF + IF (CHECK) THEN !Check for gradient of F zero, + TEST = 0. !i.e., spurious convergence. + DEN = MAX( F, 0.5 * N ) + DO I = 1, N + TEMP = ABS( G( I ) ) * MAX( ABS( X( I ) ), 1.0 ) / DEN + IF ( TEMP .GT. TEST ) TEST = TEMP + END DO + IF ( TEST .LT. TOLMIN ) THEN + CHECK = .TRUE. + ELSE + CHECK = .FALSE. + END IF + RETURN + END IF + TEST = 0.0 !Test for convergence on delta_x + DO I = 1, N + TEMP = ( ABS( X( I ) - XOLD( I ) ) ) / MAX( ABS( X( I ) ), 1.0 ) + IF ( TEMP .GT. TEST ) TEST = TEMP + END DO + IF ( TEST .LT. TOLX ) RETURN + END DO + WRITE( *,'(a,i2)' ) 'MAXITS exceeded in NEWT ! Layer: ', LAYER + END SUBROUTINE NEWT + +C----------------------------------------------------------------------- + SUBROUTINE FDJAC( N, X, FJAC ) + +C Description: +C Get the Jacobian of the function + +C ( a1 * X1^2 + b1 * X1 + c1 ) +C ( a2 * X2^2 + b2 * X2 + c2 ) +C ( a3 * X3^2 + b3 * X3 + c3 ) +C F(X) = ( a4 * X4^2 + b4 * X4 + c4 ) = 0.0 +C ( ........................ ) +C ( aN * XN^2 + bN * XN + cN ) +C +C a_i = IMW_i +C b_i = SUM(X_j * IMW_j)_j.NE.i + CSAT_i * IMW_i + M +C - CTOT_i * IMW_i +C +C c_i = - CTOT_i * [ SUM(X_j * IMW_j)_j.NE.i + M ] +C +C delta F_i ( 2. * a_i * X_i + b_i If i .EQ. j +C J_ij = ----------- = ( +C delta X_j ( ( X_i - CTOT_i ) * IMW_j If i .NE. j + +C Revision History: +C CGN 01/12/04 changed B1 & B2 to scalars +C SH 02/10/10 renamed NCVAP to n_vapor. Value is inherited from SOA_DEFN. + + IMPLICIT NONE + + INTEGER N ! dimension of problem + REAL X( N ) ! initial guess of CAER + + REAL CT + REAL CS + REAL IMW + REAL M + COMMON /NEWTINP/ CT( N_VAPOR ), CS( N_VAPOR ), IMW( N_VAPOR ), M + + REAL FJAC( N,N ) + + INTEGER I, J ! loop index + REAL A( N_VAPOR ) + REAL B( N_VAPOR ) + REAL B1 + REAL B2 + REAL SUM_JNEI + + DO I = 1, N + A( I ) = IMW( I ) + SUM_JNEI = 0.0 + DO J = 1, N + SUM_JNEI = SUM_JNEI + X( J ) * IMW( J ) + END DO + B1 = SUM_JNEI - ( X( I ) * IMW( I ) ) + B2 = ( CS( I ) - CT( I ) ) * IMW( I ) + M + B( I ) = B1 + B2 + END DO + DO J = 1, N + DO I = 1, N + IF ( I .EQ. J ) THEN + FJAC( I,J ) = 2.0 * A( I ) * X( I ) + B( I ) + ELSE + FJAC( I,J ) = ( X( I ) - CT( I ) ) * IMW( J ) + END IF + END DO + END DO + + RETURN + END SUBROUTINE FDJAC + +C----------------------------------------------------------------------- + SUBROUTINE FMINV( X,F ) + +C Description: +C Returns f = 0.5 * F*F at X. SR FUNCV(N,X,F) is a fixed-name, +C user-supplied routine that returns the vector of functions at X. +C The common block NEWTV communicates the function values back to +C NEWT. + +C Adopted from Numerical Recipes in FORTRAN, Chapter 9.7, 2nd ed. + +C Key Subroutines Called: FUNCV + +C Revision History: +C YOJ 07/31/02 changed FUNCTION FMIN to SUBROUTINE FMINV to avoid errors +C with (some) compilers +C SH 02/10/10 renamed NCVAP to n_vapor. Value is inherited from SOA_DEFN. + + IMPLICIT NONE + + INTEGER N + + REAL X( * ), F + REAL FVEC + + COMMON /NEWTV/ FVEC( N_VAPOR ), N + SAVE /NEWTV/ + + INTEGER I + REAL SUM + CALL FUNCV( N, X, FVEC ) + SUM = 0.0 + DO I = 1, N + SUM = SUM + FVEC( I ) ** 2 + END DO + F = 0.5 * SUM + RETURN + END SUBROUTINE FMINV + +C----------------------------------------------------------------------- + SUBROUTINE FUNCV( N, X, FVEC ) + +C Description: +C From Equation (8) of Schell et al., 2001: +C Caer,i = Ctot,i - Csat,i * (Caer,i/MWi) / +C ( sum_j (Caer,j/MWj) + Cinit/MWinit) +C Let Xi = Caer,i +C a_i = 1 / MWi +C M = Cinit/MWinit +C CTi = Ctot,i +C CSi = Csat,i +C Then, +C Xi = CTi - CSi * (a_i * Xi) / ( sum_j (a_j * Xj) + M ) +C +C Multiply above equation by sum_j(a_j*Xj) + M and group terms +C a_i Xi^2 + ( sum_jnei (a_j*Xj) + M + CSi*a_i - CTi*a_i ) Xi +C - CTi * ( sum_jnei (a_j*Xj) + M ) = 0 +C +C This equation is of the form F(X) = a_i*Xi^2 + b_i*Xi + c_i = 0. +C F(X) is stored as FVEC in this subroutine. +C +C See also FDJAC. + +C Key Subroutines Called: none + +C Revision History: +C CGN 01/12/04 Added documentation, removed extraneous lines of code +C SH 02/10/10 renamed NCVAP to n_vapor. Value is inherited from SOA_DEFN + +C References: +C 1. Schell, B., I. J. Ackermann, H. Hass, F. S. Binkowski, and +C A. Abel, Modeling the formation of secondary organic aerosol +C within a comprehensive air quality modeling system, J. Geophys. +C Res., Vol 106, No D22, 28275-28293, 2001. + + IMPLICIT NONE + + INTEGER N + REAL X( * ) + REAL FVEC( N ) + + REAL CT + REAL CS + REAL IMW + REAL M + COMMON /NEWTINP/ CT( N_VAPOR ), CS( N_VAPOR ), IMW( N_VAPOR ), M + SAVE /NEWTINP/ + + INTEGER I, J + REAL SUM_JNEI + REAL A( N_VAPOR ) + REAL B( N_VAPOR ) + REAL C( N_VAPOR ) + + DO I = 1, N + A( I ) = IMW( I ) + SUM_JNEI = 0.0 + DO J = 1, N + SUM_JNEI = SUM_JNEI + X( J ) * IMW( J ) + END DO + SUM_JNEI = SUM_JNEI - ( X( I ) * IMW( I ) ) + B( I ) = SUM_JNEI + M + ( CS( I ) - CT( I ) ) * IMW( I ) + C( I ) = -CT( I ) * ( SUM_JNEI + M ) + FVEC( I ) = X( I ) * ( A( I ) * X( I ) + B( I ) ) + C( I ) + END DO + + RETURN + END SUBROUTINE FUNCV + +C----------------------------------------------------------------------- + SUBROUTINE LNSRCH( CTOT, + & N, XOLD, FOLD, G, P, + & X, F, STPMAX, TOLX, CHECK) + +C Description: +C Given an n-dimensional point XOLD(1:N), the value of the function +C and gradient there, FOLD and G(1:N), and a direction P(1:N), +C finds a new point X(1:N) along the direction P from XOLD where +C the function FUNC has decreased 'sufficiently'. The new function +C value is returned in F. STPMAX is an input quantity that limits +C the length of the steps so that you do not try to evaluate the +C function in regions where it is undefined or subject to overflow. +C P is usually the Newton direction. The output quantity CHECK is +C false on a normal exit. It is true when X is too close to XOLD. +C In a minimization algorithm, this usually signals convergence and +C can be ignored. However, in a zero-finding algorithm the calling +C program should check whether the convergence is spurious. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 9.7, 2nd ed. + +C Key Subroutines Called: FUNCV + +C Revision History: +C SH 02/10/10 added TOLX to the call vector. In previous versions, this +C parameter was declared in the Module SOA_NEWT (which contained this +C subroutine). + + IMPLICIT NONE + + INTEGER N + REAL TOLX + LOGICAL CHECK + REAL F, FOLD, STPMAX + REAL G( N ), P( N ), X( N ), XOLD( N ) + REAL CTOT( N ) + REAL, PARAMETER :: ALF = 1.E-04 + REAL, PARAMETER :: CONMIN = 1.E-30 + + INTEGER I + REAL A, ALAM, ALAM2, ALAMIN, B, DISC + REAL F2, FOLD2, RHS1, RHS2, SLOPE + REAL SUM, TEMP, TEST, TMPLAM + + CHECK = .FALSE. + SUM = 0.0 + DO I = 1, N + SUM = SUM + P( I ) * P( I ) + END DO + SUM = SQRT( SUM ) + IF ( SUM .GT. STPMAX ) THEN + DO I = 1, N + P( I ) = P( I ) * STPMAX / SUM + END DO + END IF + SLOPE = 0.0 + DO I = 1, N + SLOPE = SLOPE + G( I ) * P( I ) + END DO + TEST = 0.0 + DO I = 1, N + TEMP = ABS( P( I ) ) / MAX( ABS( XOLD( I ) ), 1.0 ) + IF ( TEMP .GT. TEST ) TEST = TEMP + END DO + ALAMIN = TOLX / TEST + ALAM = 1.0 + +101 CONTINUE + +C avoid negative concentrations and set upper limit given by CTOT. + + DO I = 1, N + X( I ) = XOLD( I ) + ALAM * P( I ) + IF ( X( I ) .LE. 0.0 ) X( I ) = CONMIN + IF ( X( I ) .GT. CTOT( I ) ) X( I ) = CTOT( I ) + END DO + CALL FMINV( X,F ) + IF ( ALAM .LT. ALAMIN ) THEN + DO I = 1, N + X( I ) = XOLD( I ) + END DO + CHECK = .TRUE. + RETURN + ELSE IF ( F .LE. FOLD + ALF * ALAM * SLOPE ) THEN + RETURN + ELSE + IF ( ALAM .EQ. 1.0 ) THEN + TMPLAM = -SLOPE / ( 2.0 * ( F - FOLD - SLOPE ) ) + ELSE + RHS1 = F - FOLD - ALAM * SLOPE + RHS2 = F2 - FOLD2 - ALAM2 * SLOPE + A = ( RHS1 / ALAM ** 2 - RHS2 / ALAM2 ** 2 ) / ( ALAM - ALAM2 ) + B = ( -ALAM2 * RHS1 / ALAM ** 2 + ALAM * RHS2 / ALAM2 ** 2 ) + & / ( ALAM - ALAM2 ) + IF ( A .EQ. 0.0 ) THEN + TMPLAM = -SLOPE / ( 2.0 * B ) + ELSE + DISC = B * B - 3.0 * A * SLOPE + TMPLAM = ( -B + SQRT( DISC ) ) / ( 3.0 * A ) + END IF + IF ( TMPLAM .GT. 0.5 * ALAM ) TMPLAM = 0.5 * ALAM + END IF + END IF + ALAM2 = ALAM + F2 = F + FOLD2 = FOLD + ALAM = MAX( TMPLAM, 0.1 * ALAM ) + GO TO 101 + + END SUBROUTINE LNSRCH + +C----------------------------------------------------------------------- + SUBROUTINE LUBKSB( A, N, INDX, B ) + +C Description: +C Solves the set of N linear equations A * X = B. Here A is input, +C not as the matrix A but rather as its LU decomposition, +C determined by the routine LUDCMP. B(1:N) is input as the right- +C hand side vector B, and returns with the solution vector X. A, N, +C and INDX are not modified by this routine and can be left in +C place for successive calls with different right-hand sides B. +C This routine takes into account the possibility that B will begin +C with many zero elements, so it is efficient for use in matrix +C inversion. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 2.3, 2nd ed. +C +C Key Subroutines Called: none +C +C Revision History: +C call vector modified to remove NCVAP and set dimensions to N. + + IMPLICIT NONE + + INTEGER N, INDX( N ) + REAL A( N,N ), B( N ) ! A now has dimension NxN. + + INTEGER I, II, J, LL + REAL SUM + + II = 0 + DO I = 1, N + LL = INDX( I ) + SUM = B( LL ) + B( LL ) = B( I ) + IF ( II .NE. 0 ) THEN + DO J = II, I-1 + SUM = SUM - A( I,J ) * B( J ) + END DO + ELSE IF ( SUM .NE. 0 ) THEN + II = I + END IF + B( I ) = SUM + END DO + DO I = N, 1, -1 + SUM = B( I ) + DO J = I+1, N + SUM = SUM - A( I,J ) * B( J ) + END DO + B( I ) = SUM / A( I,I ) + END DO + + RETURN + END SUBROUTINE LUBKSB + +C----------------------------------------------------------------------- + SUBROUTINE LUDCMP( A, N, INDX, D ) + +C Description: +C Given a matrix A(1:N,1:N), with physical dimension N by N, this +C routine replaces it by the LU decomposition of a rowwise +C permutation of itself. A and N are input. A is output arranged as +C in equation (2.3.14) above; INDX(1:N) is an output vector that +C records vector that records the row permutation effected by the +C partial pivoting; D is output as +-1 depending on whether the +C number of row interchanges was even or odd, respectively. This +C routine is used in combination with SR LUBKSB to solve linear +C equations or invert a matrix. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 2.3, 2nd ed. + +C Equation (2.3.14) Numerical Recipes, p 36: +C | b_11 b_12 b_13 b_14 | +C | a_21 b_22 b_23 b_24 | +C | a_31 a_32 b_33 b_34 | +C | a_41 a_42 a_43 b_44 | + +C Key Subroutines Called: None + +C Revision History: +C call vector modified to remove NCVAP +C all dimensions now depend upon N only + + IMPLICIT NONE + + INTEGER N, INDX( N ) +! INTEGER NMAX +! PARAMETER ( NMAX = 10 ) ! largest expected N + REAL D, A( N,N ) ! note that A now has dimension NxN + ! NCVAP is ignored + REAL, PARAMETER :: TINY = 1.0E-20 + + INTEGER I, IMAX, J, K + REAL AAMAX, DUM, SUM, VV( N ) + + D = 1 + DO I = 1, N + AAMAX = 0.0 + DO J = 1, N + IF ( ABS(A( I,J ) ) .GT. AAMAX ) AAMAX = ABS( A( I,J ) ) + END DO + IF ( AAMAX .EQ. 0.0 ) THEN + WRITE( *,'(a)' ) '*** Singular matrix in ludcmp!' +! STOP + END IF + VV( I ) = 1.0 / AAMAX + END DO + DO J = 1, N + DO I = 1, J-1 + SUM = A( I,J ) + DO K = 1, I-1 + SUM = SUM - A( I,K ) * A( K,J ) + END DO + A( I,J ) = SUM + END DO + AAMAX = 0.0 + DO I = J, N + SUM = A( I,J ) + DO K = 1, J-1 + SUM = SUM - A( I,K ) * A( K,J ) + END DO + A( I,J ) = SUM + DUM = VV( I ) * ABS( SUM ) + IF ( DUM .GE. AAMAX ) THEN + IMAX = I + AAMAX = DUM + END IF + END DO + IF ( J .NE. IMAX ) THEN + DO K = 1, N + DUM = A( IMAX,K ) + A( IMAX,K ) = A( J,K ) + A( J,K ) = DUM + END DO + D = -D + VV( IMAX ) = VV( J ) + END IF + INDX( J ) = IMAX + IF ( A( J,J ) .EQ. 0.0 ) A( J,J ) = TINY + IF ( J .NE. N ) THEN + DUM = 1.0 / A( J,J ) + DO I = J+1, N + A( I,J ) = A( I,J ) * DUM + END DO + END IF + END DO + + RETURN + END SUBROUTINE LUDCMP + + End Module soa_defn diff --git a/models/CCTM/aero/aero_noop/aero_depv.F b/models/CCTM/aero/aero_noop/aero_depv.F new file mode 100755 index 0000000..54f1430 --- /dev/null +++ b/models/CCTM/aero/aero_noop/aero_depv.F @@ -0,0 +1,1132 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/aero_depv.F,v 1.12 2012/01/19 13:12:14 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C @(#)aero_depv.F 1.3 /project/mod3/CMAQ/src/ae_depv/aero_depv/SCCS/s.aero_depv.F 18 Jun 1997 12:55:48 + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE AERO_DEPV ( CGRID, JDATE, JTIME, TSTEP, MOSAIC, VDEP_AE ) + +C----------------------------------------------------------------------- +C aerosol dry deposition routine +C written 4/9/97 by Dr. Francis S. Binkowski +C uses code from modpar and vdvg from the aerosol module. +C This routine uses a single block to hold information +C for the lowest layer. +C NOTES: This version assumes that RA is available on the met file. +c Array structure for vector optimization +C 26 Apr 97 Jeff - many mods +C 13 Dec 97 Jeff - expect uncoupled CGRID, concs as micro-g/m**3, #/m**3 +C +C 1/11/99 David Wong at LM - change NUMCELLS to CELLNUM in the loop index +C FSB 3/17/99 changed to accommodate surface area/second moment and +C encapsulated the actual drydep calculation into a subroutine which +C is attached to this code +C Jeff - Dec 00 - move CGRID_MAP into f90 module +C FSB 12/11/2000. Logic added to allow deposition of particles at their +C "wet" diameters; that is, accounting for the water on the particles. +C This is done by adjusting the third and second moments for the +C presence of water assuming that the geometric standard deviations +C are not changed by this process. This appears to be a very good +C assumption. +C 30 Aug 01 J.Young: Dyn alloc; Use HGRD_DEFN +C Jan 03 J.Young: Change CGRID dimensions, eliminate re-allocations +C 6 Mar 03 J.Young: eliminate a lot of allocate/deallocates +C 7 Aug 03 S.Roselle: updated code for loading the min aero conc array +C 17 Dec 03 S.Roselle: Adjust 2nd and 3rd moments to include SOA, +C without affecting the geometric standard deviations. +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 07 Jun 05 P.Bhave: Added code to handle new species in the AE4 +C mechanism: ANAI, ANAJ, ANAK, ACLI, ACLJ, ACLK, ASO4K, AH2OK, +C and ANO3K; look for ASEAS only when using AE3 mechanism +C 30 Jan 08 S.Napelenok & P.Bhave: Added code to handle new SOA species +C in AE5; defined DRY aerosol to include nonvolatile SOA spcs +C 14 Apr 08 J.Kelly: Added code to handle new species ANH4K and SRFCOR. +C Also added code to handle variable coarse mode standard deviation +C in AE5 (no longer fixed at 2.2). +C 08 Sep 08 P.Bhave: Backward compatibility with AE4 mechanisms +C standardized names of all coarse-mode variables +C 19 Apr 10 S.Howard: aero re-engineering for modularity +C 23 Apr 10 J.Young: replace chem mechanism include files with namelists +C 10 Mar 11 S.Howard: Renamed met_data to aeromet_data +C 25 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C 20 May 11 D.Schwede: Modified for mosaic +C 31 Aug 11 J.Bash: Moved shared mosaic variables to MOSAIC_MOD +C 27 Sep 11 David Wong: replaced all run time dynamic arrays with allocatable +C arrays to avoid run time memory issue +C 08 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain specifications + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + USE AERO_DATA ! aero variable data + USE SOA_DEFN ! gas soa data + USE AEROMET_DATA ! Includes CONST.EXT + USE Mosaic_Mod, Only: ADEPVJ, USTARJ, RAJ ! Shared mosaic variables + Use LSM_Mod, Only: N_LUFRAC + Use DEPV_DEFN, Only: ABFLUX + + IMPLICIT NONE + +C Includes: + + INCLUDE SUBST_RXCMMN ! to get mech name + INCLUDE SUBST_FILES_ID ! file name parameters + +C Arguments + REAL, POINTER :: CGRID( :,:,:,: ) + INTEGER, INTENT( IN ) :: JDATE ! current model date , coded YYYYDDD + INTEGER, INTENT( IN ) :: JTIME ! current model time , coded HHMMSS + INTEGER, INTENT( IN ) :: TSTEP ! model time step, coded HHMMSS +! REAL, INTENT( IN ) :: USTARJ( :,:,: ) ! friction velocity [m/s ] for each land use category +! REAL, INTENT( IN ) :: RAJ ( :,:,: ) ! aerodynamic resistance [ s/m ] for each land use category + LOGICAL, INTENT( IN ) :: MOSAIC ! use mosaic option + REAL, INTENT( OUT ) :: VDEP_AE( :,:,: ) ! surrogate deposition velocities [ m s**-1 ] +! REAL, INTENT( OUT ) :: VDEPJ_AE( :,:,:,: ) ! surrogate deposition velocities [ m s**-1 ] for each land use category + +C Parameters + REAL, PARAMETER :: T0 = 288.15 ! [ K ] ! starting standard surface temp. + REAL, PARAMETER :: P0 = 101325.0 ! standard surface pressure [ Pa ] + REAL, PARAMETER :: TWO3 = 2.0 / 3.0 + INTEGER, PARAMETER :: N_AE_DEP_SPC = 9 ! no. of surrogates for aerosol dry dep velocities + +C set up species dimension and indices for deposition velocity internal array VDEP + INTEGER, PARAMETER :: VDNATK = 1, ! Aitken mode number + & VDNACC = 2, ! accumulation mode number + & VDNCOR = 3, ! coarse mode number + & VDMATK = 4, ! Aitken mode mass + & VDMACC = 5, ! accumulation mode mass + & VDMCOR = 6, ! coarse mode mass + & VDSATK = 7, ! Aitken mode surface area + & VDSACC = 8, ! accumulation mode surface area + & VDSCOR = 9 ! coarse mode surface area + +C Local variables: + + CHARACTER( 16 ) :: VDAE_NAME( N_AE_DEP_SPC )! dep vel surrogate name table + DATA VDAE_NAME( 1 ) / 'VNUMATKN' / + DATA VDAE_NAME( 2 ) / 'VNUMACC ' / + DATA VDAE_NAME( 3 ) / 'VNUMCOR ' / + DATA VDAE_NAME( 4 ) / 'VMASSI ' / + DATA VDAE_NAME( 5 ) / 'VMASSJ ' / + DATA VDAE_NAME( 6 ) / 'VMASSC ' / + DATA VDAE_NAME( 7 ) / 'VSRFATKN' / + DATA VDAE_NAME( 8 ) / 'VSRFACC ' / + DATA VDAE_NAME( 9 ) / 'VSRFCOR ' / + + INTEGER, ALLOCATABLE, SAVE :: DEPV_SUR( : ) ! pointer to surrogate + +C Meteorological variables +! REAL PRES ( NCOLS,NROWS ) ! Atmospheric pressure [ Pa ] +! REAL TA ( NCOLS,NROWS ) ! Air temperature [ K ] +! REAL DENS ( NCOLS,NROWS ) ! Air density [ kg/m**3 ] +! REAL RA ( NCOLS,NROWS ) ! aerodynamic resistance [ s/m ] +! REAL USTAR ( NCOLS,NROWS ) ! friction velocity [m/s ] +! REAL WSTAR ( NCOLS,NROWS ) ! convective velocity scale [m/s ] +! REAL HEATFLUX( NCOLS,NROWS ) ! surface heat flux [W/m**2] + + REAL, ALLOCATABLE, SAVE :: PRES ( :,: ) ! Atmospheric pressure [ Pa ] + REAL, ALLOCATABLE, SAVE :: TA ( :,: ) ! Air temperature [ K ] + REAL, ALLOCATABLE, SAVE :: DENS ( :,: ) ! Air density [ kg/m**3 ] + REAL, ALLOCATABLE, SAVE :: RA ( :,: ) ! aerodynamic resistance [ s/m ] + REAL, ALLOCATABLE, SAVE :: USTAR ( :,: ) ! friction velocity [m/s ] + REAL, ALLOCATABLE, SAVE :: WSTAR ( :,: ) ! convective velocity scale [m/s ] + REAL, ALLOCATABLE, SAVE :: HEATFLUX( :,: ) ! surface heat flux [W/m**2] + + CHARACTER( 16 ), SAVE :: AE_VRSN ! Aerosol version name + + INTEGER, SAVE :: NCELLS ! number of cells per layer + + REAL, ALLOCATABLE, SAVE :: XXLSGAT( :,: ) ! log of standard deviation + REAL, ALLOCATABLE, SAVE :: XXLSGAC( :,: ) + REAL, ALLOCATABLE, SAVE :: XXLSGCO( :,: ) + + REAL, ALLOCATABLE, SAVE :: DGATK( :,: ) ! geometric mean diameter + REAL, ALLOCATABLE, SAVE :: DGACC( :,: ) + REAL, ALLOCATABLE, SAVE :: DGCOR( :,: ) + + REAL, ALLOCATABLE, SAVE :: PDENSAT( :,: ) ! particle density + REAL, ALLOCATABLE, SAVE :: PDENSAC( :,: ) + REAL, ALLOCATABLE, SAVE :: PDENSCO( :,: ) + + REAL, ALLOCATABLE, SAVE :: XLM( :,: ) ! mean free path [ m ] + REAL, ALLOCATABLE, SAVE :: AMU( :,: ) ! dynamic viscosity [ kg m**-1 s**-1 ] + + REAL, ALLOCATABLE, SAVE :: VDEP( :,:,: ) ! deposition velocity [ m/s ] + REAL, ALLOCATABLE, SAVE :: VDEPJ( :,:,:,: ) ! deposition velocity [ m/s ] + + REAL M3_WET, M3SUBT, M3_DRY + REAL M2_WET, M2_DRY + + LOGICAL, SAVE :: FIRSTIME = .TRUE. + INTEGER, SAVE :: LOGDEV ! unit number for the log file + CHARACTER( 16 ), SAVE :: PNAME = 'AERO_DEPV' + CHARACTER( 16 ) :: VNAME ! varable name + CHARACTER( 96 ) :: XMSG = ' ' + + INTEGER MDATE, MTIME, MSTEP ! julian date, time and timestep in sec + INTEGER C, R, V, N, J ! loop counters + INTEGER SPC, S ! species loop counter + INTEGER ALLOCSTAT + + INTEGER GXOFF, GYOFF ! global origin offset from file + INTEGER, SAVE :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + + INTERFACE + SUBROUTINE GETDEP_V ( BLKTA, BLKDENS, + & XLM, AMU, + & BLKWSTAR, BLKUSTAR, BLKRA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, + & MOSAIC, BLKUSTARJ, BLKRAJ ) + REAL, INTENT( IN ) :: BLKTA ( :,: ) ! air temperature [ K ] + REAL, INTENT( IN ) :: BLKDENS( :,: ) ! air density [ kg/m**3 ] + REAL, INTENT( IN ) :: XLM( :,: ) ! atmospheric mean free path [ m ] + REAL, INTENT( IN ) :: AMU( :,: ) ! atmospheric dynamic viscosity [ kg/(m s) ] + REAL, INTENT( IN ) :: BLKWSTAR( :,: ) ! convective velocity scale [ m/s ] + REAL, INTENT( IN ) :: BLKUSTAR( :,: ) ! friction velocity [ m/s ] + REAL, INTENT( IN ) :: BLKRA ( :,: ) ! aerodynamic resistance [ s/m ] + REAL, INTENT( IN ) :: DGATK( :,: ) ! nuclei mode geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGACC( :,: ) ! accumulation geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGCOR( :,: ) ! coarse mode geometric mean diameter [ m ] + REAL, INTENT( IN ) :: XXLSGAT( :,: ) ! Aitken mode + REAL, INTENT( IN ) :: XXLSGAC( :,: ) ! accumulation mode + REAL, INTENT( IN ) :: XXLSGCO( :,: ) ! coarse mode + REAL, INTENT( IN ) :: PDENSAT( :,: ) ! average particle density in nuclei mode + REAL, INTENT( IN ) :: PDENSAC( :,: ) ! average particle density in accumulation mode + REAL, INTENT( IN ) :: PDENSCO( :,: ) ! average particle density in coarse mode + REAL, INTENT( OUT ) :: VDEP( :,:,: ) ! deposition velocity [ m/s ] + REAL, INTENT( OUT ) :: VDEPJ( :,:,:,: ) ! deposition velocity [ m/s ] for each land use category + LOGICAL, INTENT( IN ) :: MOSAIC + REAL, OPTIONAL, INTENT( IN ) :: BLKUSTARJ( :,:,: ) ! friction velocity [ m/s ] + REAL, OPTIONAL, INTENT( IN ) :: BLKRAJ ( :,:,: ) ! aerodynamic resistance [ s/m ] + END SUBROUTINE GETDEP_V + END INTERFACE + +C----------------------------------------------------------------------- + + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. + LOGDEV = INIT3() + + NCELLS = NCOLS * NROWS + +C Allocate arrays + ALLOCATE( XXLSGAT( NCOLS,NROWS ), + & XXLSGAC( NCOLS,NROWS ), + & XXLSGCO( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating XXLSGAT, XXLSGAC or XXLSGCO' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( DGATK( NCOLS,NROWS ), + & DGACC( NCOLS,NROWS ), + & DGCOR( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DGATK, DGACC or DGCOR' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( PDENSAT( NCOLS,NROWS ), + & PDENSAC( NCOLS,NROWS ), + & PDENSCO( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating PDENSAT, PDENSAC or PDENSCO' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( XLM( NCOLS,NROWS ), + & AMU( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating XLM or AMU' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +! ALLOCATE ( VDEP( NCELLS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + ALLOCATE ( VDEP( NCOLS,NROWS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating VDEP' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( PRES ( NCOLS,NROWS ), + & TA ( NCOLS,NROWS ), + & DENS ( NCOLS,NROWS ), + & RA ( NCOLS,NROWS ), + & USTAR ( NCOLS,NROWS ), + & WSTAR ( NCOLS,NROWS ), + & HEATFLUX( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating arrays' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +! ALLOCATE ( VDEPJ( N_LUFRAC,NCELLS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + ALLOCATE ( VDEPJ( N_LUFRAC,NCOLS,NROWS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating VDEPJ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + IF ( MOSAIC ) THEN + ALLOCATE ( ADEPVJ( N_LUFRAC,N_AE_DEPV,NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating ADEV' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END IF + + ALLOCATE ( DEPV_SUR( N_AE_DEPV ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DEPV_SUR' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Open the met files + IF ( .NOT. OPEN3( MET_CRO_3D, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open MET_CRO_3D file ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + IF ( .NOT. OPEN3( MET_CRO_2D, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open MET_CRO_2D file ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + 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 + +C Set the dep vel surrogate pointers + DO V = 1, N_AE_DEPV + N = INDEX1( AE_DEPV( V ), N_AE_DEP_SPC, VDAE_NAME ) + IF ( N .NE. 0 ) THEN + DEPV_SUR( V ) = N + ELSE + XMSG = 'Could not find ' // AE_DEPV( V ) // ' in aerosol' // + & ' surrogate table. >>> Dep vel set to zero <<< ' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + DEPV_SUR( V ) = 0 + END IF + END DO + +C *** get file horizontal grid offsets + CALL SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + END IF ! FIRSTIME + + IF ( N_AE_SPC .LE. 0 ) RETURN + +C begin interpolation of meteorological variables + + MDATE = JDATE + MTIME = JTIME + +C Interpolate time dependent one-layer and layered input variables + +ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc + VNAME = 'RADYNI' + IF ( INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, RA ) ) THEN + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + RA( C,R ) = 1.0 / MAX( RA( C,R ), CONMIN ) + END DO + END DO + ELSE + VNAME = 'RA' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, RA ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + END IF +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + VNAME = 'USTAR' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, USTAR ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'WSTAR' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, WSTAR ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'HFX' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, HEATFLUX ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +C Layered variables TA, PRES, DENS: + + VNAME = 'PRES' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,1, + & MDATE, MTIME, PRES ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_3D ' + CALL M3EXIT (PNAME, MDATE, MTIME, XMSG, XSTAT1) + END IF + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,1, + & MDATE, MTIME, TA ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_3D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'DENS' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,1, + & MDATE, MTIME, DENS ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_3D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +C ----------End interpolation of meteorological variables ------------- + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +C Put the grid cell physical data in the block arrays +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +C *** Set meteorological data for the grid cell. + AIRDENS = DENS( C,R ) + AIRTEMP = TA( C,R ) + AIRPRES = PRES( C,R ) + +C *** extract grid cell concentrations of aero species from CGRID +C into aerospc_conc in aero_data module + CALL EXTRACT_AERO( CGRID( C,R,1,: ), .TRUE. ) + +C *** extract soa concentrations from CGRID + CALL EXTRACT_SOA( CGRID( C,R,1,: ) ) + +C *** Calculate aerosol surface area to 2nd moment. + DO S = 1, N_MODE + N = AEROSRF_MAP( S ) + MOMENT2_CONC( S ) = CGRID( C,R,1,N ) / PI + END DO + +C *** Calculate geometric mean diameters and standard deviations of the +C "dry" size distribution + CALL GETPAR( .FALSE., .FALSE. ) + +C add contribution of water and SOA + +C Aitken mode. + M3_DRY = MOMENT3_CONC( 1 ) + M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) + & * AEROSPC_CONC( AH2O_IDX,1 ) + M3_WET = M3_DRY + M3SUBT + M2_DRY = MOMENT2_CONC( 1 ) + M2_WET= M2_DRY * ( M3_WET / M3_DRY ) ** TWO3 + + MOMENT3_CONC( 1 ) = MAX( CONMIN, M3_WET ) + MOMENT2_CONC( 1 ) = MAX( CONMIN, M2_WET ) + +C accumulation mode. + M3_DRY = MOMENT3_CONC( 2 ) + + M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) + & * AEROSPC_CONC( AH2O_IDX,2 ) + DO SPC = 1, N_VAPOR + M3SUBT = M3SUBT + ( 1.0E-9 * F6PI / AEROSPC( APOC_IDX )%DENSITY ) + & * AEROSPC_CONC( SOA_AEROMAP( SPC ),2 ) + END DO + + M3_WET = M3_DRY + M3SUBT + M2_DRY = MOMENT2_CONC(2) + M2_WET = M2_DRY * ( M3_WET / M3_DRY ) ** TWO3 + + MOMENT3_CONC( 2 ) = MAX( CONMIN, M3_WET ) + MOMENT2_CONC( 2 ) = MAX( CONMIN, M2_WET ) + +C coarse mode + M3_DRY = moment3_conc(3) + M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) + & * AEROSPC_CONC( AH2O_IDX,3 ) + M3_WET = M3_DRY + M3SUBT + M2_DRY = MOMENT2_CONC( 3 ) + M2_WET = M2_DRY * ( M3_WET / M3_DRY ) ** TWO3 + + MOMENT3_CONC( 3 ) = MAX( CONMIN, M3_WET ) + MOMENT2_CONC( 3 ) = MAX( CONMIN, M2_WET ) + +C *** Calculate geometric mean diameters and standard deviations of the +C "wet" size distribution + CALL GETPAR( .TRUE., .FALSE. ) + +C Save getpar values to arrays + XXLSGAT( C,R ) = AEROMODE_SDEV( 1 ) + XXLSGAC( C,R ) = AEROMODE_SDEV( 2 ) + XXLSGCO( C,R ) = AEROMODE_SDEV( 3 ) + + DGATK( C,R ) = AEROMODE_DIAM( 1 ) + DGACC( C,R ) = AEROMODE_DIAM( 2 ) + DGCOR( C,R ) = AEROMODE_DIAM( 3 ) + + PDENSAT( C,R ) = AEROMODE_DENS( 1 ) + PDENSAC( C,R ) = AEROMODE_DENS( 2 ) + PDENSCO( C,R ) = AEROMODE_DENS( 3 ) + +C Calculate mean free path [ m ]: + XLM( C,R ) = 6.6328E-8 * P0 * AIRTEMP / ( T0 * AIRPRES ) + +C *** Calcualte dynamic viscosity [ kg m**-1 s**-1 ]: + AMU( C,R ) = 1.458E-6 * AIRTEMP * SQRT( AIRTEMP ) + & / ( AIRTEMP + 110.4 ) + + END DO ! Column LOOP + END DO ! Row LOOP + +C *** get dry deposition velocities: + +! CALL GETDEP_V ( NCELLS, N_AE_DEP_SPC, + IF ( MOSAIC .OR. ABFLUX ) THEN + CALL GETDEP_V ( TA, DENS, + & XLM, AMU, + & WSTAR, USTAR, RA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, + & MOSAIC, USTARJ, RAJ ) + ELSE + CALL GETDEP_V ( TA, DENS, + & XLM, AMU, + & WSTAR, USTAR, RA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, MOSAIC ) + END IF + +C Return dry deposition velocities for aerosols (first layer only). + +! N = 0 + DO R = 1, NROWS + DO C = 1, NCOLS +! N = N + 1 + DO V = 1, N_AE_DEPV + IF ( DEPV_SUR( V ) .GT. 0 ) THEN +! VDEP_AE( V,C,R ) = VDEP( N,DEPV_SUR( V ) ) + VDEP_AE( V,C,R ) = VDEP( C,R,DEPV_SUR( V ) ) + ELSE + VDEP_AE( V,C,R ) = 0.0 + END IF + END DO + END DO + END DO + +! N = 0 + IF ( MOSAIC ) THEN + DO R = 1, NROWS + DO C = 1, NCOLS +! N = N + 1 + DO V = 1, N_AE_DEPV + DO J = 1, N_LUFRAC + IF ( DEPV_SUR( V ) .GT. 0 ) THEN +! ADEPVJ( J,V,C,R ) = VDEPJ( J,N,DEPV_SUR( V ) ) + ADEPVJ( J,V,C,R ) = VDEPJ( J,C,R,DEPV_SUR( V ) ) + ELSE + ADEPVJ( J,V,C,R ) = 0.0 + END IF + END DO + END DO + END DO + END DO + END IF + + RETURN + END SUBROUTINE AERO_DEPV + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +! SUBROUTINE GETDEP_V ( NUMCELLS, N_AE_DEP_SPC, + SUBROUTINE GETDEP_V ( BLKTA, BLKDENS, + & XLM, AMU, + & BLKWSTAR, BLKUSTAR, BLKRA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, + & MOSAIC, BLKUSTARJ, BLKRAJ ) + +C *** Calculate deposition velocity for Aitken, accumulation, and +C coarse modes. +C Reference: +C Binkowski F. S., and U. Shankar, The regional particulate +C model 1. Model description and preliminary results. +C J. Geophys. Res., 100, D12, 26191-26209, 1995. + +C May 05 D.Schwede: added impaction term to coarse mode dry deposition +C 25 May 05 J.Pleim: Updated dry dep velocity calculation for aerosols +C to Venkatram and Pleim (1999) +C 20 Jul 05 J.Pleim: Changed impaction term using modal integration of +C Stokes**2 / 400 (Giorgi, 1986, JGR) +C 14 Apr 08 J.Kelly: Added code to calculate deposition velocity of +C coarse surface area and to account for variable +C standard deviation of the coarse mode. +C 08 Sep 08 P.Bhave: Backward compatibility with AE4 mechanisms +C standardized names of all coarse-mode variables +C----------------------------------------------------------------------- + + USE LSM_MOD, Only: n_lufrac ! to get n_lufrac + USE AEROMET_DATA ! Includes CONST.EXT + + IMPLICIT NONE + +C *** input arguments + +C meteorological information in blocked arays: + REAL, INTENT( IN ) :: BLKTA ( :,: ) ! air temperature [ K ] + REAL, INTENT( IN ) :: BLKDENS( :,: ) ! air density [ kg/m**3 ] + +C atmospheric properties + REAL, INTENT( IN ) :: XLM( :,: ) ! atmospheric mean free path [ m ] + REAL, INTENT( IN ) :: AMU( :,: ) ! atmospheric dynamic viscosity [ kg/(m s) ] + +C Planetary boundary laryer (PBL) variables + REAL, INTENT( IN ) :: BLKWSTAR( :,: ) ! convective velocity scale [ m/s ] + REAL, INTENT( IN ) :: BLKUSTAR( :,: ) ! friction velocity [ m/s ] + REAL, INTENT( IN ) :: BLKRA ( :,: ) ! aerodynamic resistance [ s/m ] + +C aerosol properties: + +C modal diameters: [ m ] + REAL, INTENT( IN ) :: DGATK( :,: ) ! nuclei mode geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGACC( :,: ) ! accumulation geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGCOR( :,: ) ! coarse mode geometric mean diameter [ m ] + +C log of modal geometric standard deviations + REAL, INTENT( IN ) :: XXLSGAT( :,: ) ! Aitken mode + REAL, INTENT( IN ) :: XXLSGAC( :,: ) ! accumulation mode + REAL, INTENT( IN ) :: XXLSGCO( :,: ) ! coarse mode + +C average modal particle densities [ kg/m**3 ] + REAL, INTENT( IN ) :: PDENSAT( :,: ) ! average particle density in nuclei mode + REAL, INTENT( IN ) :: PDENSAC( :,: ) ! average particle density in accumulation mode + REAL, INTENT( IN ) :: PDENSCO( :,: ) ! average particle density in coarse mode + +C Mosaic variables + REAL, OPTIONAL, INTENT( IN ) :: BLKUSTARJ( :,:,: ) ! friction velocity [ m/s ] + REAL, OPTIONAL, INTENT( IN ) :: BLKRAJ ( :,:,: ) ! aerodynamic resistance [ s/m ] + LOGICAL, INTENT( IN ) :: MOSAIC + +C *** output arguments + + REAL, INTENT( OUT ) :: VDEP( :,:,: ) ! deposition velocity [ m/s ] + REAL, INTENT( OUT ) :: VDEPJ( :,:,:,: ) ! deposition velocity [ m/s ] for each land use category + +C *** array indices hardcoded to match SUBROUTINE AERO_DEPV + INTEGER, PARAMETER :: VDNATK = 1, ! Aitken mode number + & VDNACC = 2, ! accumulation mode number + & VDNCOR = 3, ! coarse mode number + & VDMATK = 4, ! Aitken mode mass + & VDMACC = 5, ! accumulation mode mass + & VDMCOR = 6, ! coarse mode mass + & VDSATK = 7, ! Aitken mode surface area + & VDSACC = 8, ! accumulation mode surface area + & VDSCOR = 9 ! coarse mode surface area + +C modal Knudsen numbers + REAL KNATK ! Aitken mode Knudsen number + REAL KNACC ! accumulation " + REAL KNCOR ! coarse mode + +C modal particle diffusivities for number, 2nd, and 3rd moment, or mass: + REAL DCHAT0N, DCHAT0A, DCHAT0C + REAL DCHAT2N, DCHAT2A, DCHAT2C + REAL DCHAT3N, DCHAT3A, DCHAT3C + +C modal sedimentation velocities for number, 2nd, and 3rd moment, or mass: + REAL VGHAT0N, VGHAT0A, VGHAT0C + REAL VGHAT2N, VGHAT2A, VGHAT2C + REAL VGHAT3N, VGHAT3A, VGHAT3C + + INTEGER NCELL, J, C, R + + REAL DCONST1, DCONST1N, DCONST1A, DCONST1C + REAL DCONST2, DCONST3N, DCONST3A, DCONST3C + REAL SC0N, SC0A, SC0C ! Schmidt numbers for number + REAL SC2N, SC2A, SC2C ! Schmidt numbers for 2ND MOMENT + REAL SC3N, SC3A, SC3C ! Schmidt numbers for 3rd moment + REAL STOKEN, STOKEA, STOKEC ! Stokes numbers for each mode + REAL RD0N, RD0A, RD0C ! canopy resistance for number + REAL RD2N, RD2A, RD2C ! canopy resistance for 2nd moment + REAL RD3N, RD3A, RD3C ! canopy resisteance for 3rd moment + REAL UTSCALE ! scratch function of USTAR and WSTAR + REAL NU ! kinematic viscosity [ m**2 s**-1 ] + REAL USTFAC ! scratch function of USTAR, NU, and GRAV + REAL TWOXLM + + REAL, PARAMETER :: BHAT = 1.246 ! Constant from Cunningham slip correction + REAL, PARAMETER :: THREEPI = 3.0 * PI + REAL, PARAMETER :: TWO3 = 2.0 / 3.0 + +C Scalar variables for VARIABLE standard deviations. + + REAL L2SGAT, L2SGAC ! see usage + REAL L2SGCO + + REAL EAT1 ! Aitken mode exp( log^2( sigmag )/8 ) + REAL EAC1 ! accumulation mode exp( log^2( sigmag )/8 ) + REAL ECO1 ! coarse mode exp( log^2( sigmag )/8 ) + + REAL ESAT04 ! Aitken " **4 + REAL ESAC04 ! accumulation " + REAL ESCO04 ! coarse " + + REAL ESAT08 ! Aitken " **8 + REAL ESAC08 ! accumulation " + REAL ESCO08 ! coarse " + + REAL ESAT12 ! Aitken " **12 + REAL ESAC12 ! accumulation " + REAL ESCO12 ! coarse " + + REAL ESAT16 ! Aitken " **16 + REAL ESAC16 ! accumulation " + REAL ESCO16 ! coarse " + + REAL ESAT20 ! Aitken " **20 + REAL ESAC20 ! accumulation " + REAL ESCO20 ! coarse " + + REAL ESAT28 ! Aitken " **28 + REAL ESAC28 ! accumulation " + REAL ESCO28 ! coarse " + + REAL ESAT32 ! Aitken " **32 + REAL ESAC32 ! accumulation " + REAL ESCO32 ! coarse " + + REAL ESAT36 ! Aitken " **36 + REAL ESAC36 ! accumulation " + REAL ESCO36 ! coarse " + + REAL ESAT48 ! Aitken " **48 + REAL ESAC48 ! accumulation " + REAL ESCO48 ! coarse " + + REAL ESAT64 ! Aitken " **64 + REAL ESAC64 ! accumulation " + REAL ESCO64 ! coarse " + + REAL ESAT128 ! Aitken " **128 + REAL ESAC128 ! accumulation " + REAL ESCO128 ! coarse " + + REAL ESAT160 ! Aitken " **160 + REAL ESAC160 ! accumulation " + REAL ESCO160 ! coarse " + + REAL ESATM12 ! Aitken " **(-12) + REAL ESACM12 ! accumulation " + REAL ESCOM12 ! coarse " + + REAL ESATM16 ! Aitken " **(-16) + REAL ESACM16 ! accumulation " + REAL ESCOM16 ! coarse " + + REAL ESATM20 ! Aitken " **(-20) + REAL ESACM20 ! accumulation " + REAL ESCOM20 ! coarse " + + REAL ESATM32 ! Aitken " **(-32) + REAL ESACM32 ! accumulation " + REAL ESCOM32 ! coarse " + + REAL EIM ! Impaction efficiency + +C----------------------------------------------------------------------- + + VDEP = 0.0 ! array assignment + IF ( MOSAIC ) THEN + VDEPJ = 0.0 ! array assignment + END IF + + DO R = 1, SIZE( BLKTA, 2 ) + DO C = 1, SIZE( BLKTA, 1 ) + +C *** Calculate Knudsen numbers + + TWOXLM = XLM( C,R ) + XLM( C,R ) + KNATK = TWOXLM / DGATK( C,R ) + KNACC = TWOXLM / DGACC( C,R ) + KNCOR = TWOXLM / DGCOR( C,R ) + +C *** Calculate functions of variable standard deviation. + + L2SGAT = XXLSGAT( C,R ) * XXLSGAT( C,R ) + L2SGAC = XXLSGAC( C,R ) * XXLSGAC( C,R ) + L2SGCO = XXLSGCO( C,R ) * XXLSGCO( C,R ) + + EAT1 = EXP( 0.125 * L2SGAT ) + EAC1 = EXP( 0.125 * L2SGAC ) + ECO1 = EXP( 0.125 * L2SGCO ) + + ESAT04 = EAT1 ** 4 + ESAC04 = EAC1 ** 4 + ESCO04 = ECO1 ** 4 + + ESAT08 = ESAT04 * ESAT04 + ESAC08 = ESAC04 * ESAC04 + ESCO08 = ESCO04 * ESCO04 + + ESAT12 = ESAT04 * ESAT08 + ESAC12 = ESAC04 * ESAC08 + ESCO12 = ESCO04 * ESCO08 + + ESAT16 = ESAT08 * ESAT08 + ESAC16 = ESAC08 * ESAC08 + ESCO16 = ESCO08 * ESCO08 + + ESAT20 = ESAT16 * ESAT04 + ESAC20 = ESAC16 * ESAC04 + ESCO20 = ESCO16 * ESCO04 + + ESAT28 = ESAT20 * ESAT08 + ESAC28 = ESAC20 * ESAC08 + ESCO28 = ESCO20 * ESCO08 + + ESAT32 = ESAT16 * ESAT16 + ESAC32 = ESAC16 * ESAC16 + ESCO32 = ESCO16 * ESCO16 + + ESAT36 = ESAT16 * ESAT20 + ESAC36 = ESAC16 * ESAC20 + ESCO36 = ESCO16 * ESCO20 + + ESAT48 = ESAT36 * ESAT12 + ESAC48 = ESAC36 * ESAC12 + ESCO48 = ESCO36 * ESCO12 + + ESAT64 = ESAT32 * ESAT32 + ESAC64 = ESAC32 * ESAC32 + ESCO64 = ESCO32 * ESCO32 + + ESAT128 = ESAT64 * ESAT64 + ESAC128 = ESAC64 * ESAC64 + ESCO128 = ESCO64 * ESCO64 + + ESAT160 = ESAT128* ESAT32 + ESAC160 = ESAC128* ESAC32 + ESCO160 = ESCO128* ESCO32 + +C *** calculate inverses: + + ESATM12 = 1.0 / ESAT12 + ESACM12 = 1.0 / ESAC12 + ESCOM12 = 1.0 / ESCO12 + + ESATM16 = 1.0 / ESAT16 + ESACM16 = 1.0 / ESAC16 + ESCOM16 = 1.0 / ESCO16 + + ESATM20 = 1.0 / ESAT20 + ESACM20 = 1.0 / ESAC20 + ESCOM20 = 1.0 / ESCO20 + + ESATM32 = 1.0 / ESAT32 + ESACM32 = 1.0 / ESAC32 + ESCOM32 = 1.0 / ESCO32 + + DCONST1 = BOLTZMANN * BLKTA( C,R ) / ( THREEPI * AMU( C,R ) ) + DCONST1N = DCONST1 / DGATK( C,R ) + DCONST1A = DCONST1 / DGACC( C,R ) + DCONST1C = DCONST1 / DGCOR( C,R ) + DCONST2 = GRAV / ( 18.0 * AMU( C,R ) ) + DCONST3N = DCONST2 * PDENSAT( C,R ) * DGATK( C,R ) * DGATK( C,R ) + DCONST3A = DCONST2 * PDENSAC( C,R ) * DGACC( C,R ) * DGACC( C,R ) + DCONST3C = DCONST2 * PDENSCO( C,R ) * DGCOR( C,R ) * DGCOR( C,R ) + +C i-mode + DCHAT0N = DCONST1N * ( ESAT04 + BHAT * KNATK * ESAT16 ) + DCHAT2N = DCONST1N * ( ESATM12 + BHAT * KNATK * ESATM16 ) + DCHAT3N = DCONST1N * ( ESATM20 + BHAT * KNATK * ESATM32 ) + VGHAT0N = DCONST3N * ( ESAT16 + BHAT * KNATK * ESAT04 ) + VGHAT2N = DCONST3N * ( ESAT48 + BHAT * KNATK * ESAT20 ) + VGHAT3N = DCONST3N * ( ESAT64 + BHAT * KNATK * ESAT28 ) + +C j-mode + DCHAT0A = DCONST1A * ( ESAC04 + BHAT * KNACC * ESAC16 ) + DCHAT2A = DCONST1A * ( ESACM12 + BHAT * KNACC * ESACM16 ) + DCHAT3A = DCONST1A * ( ESACM20 + BHAT * KNACC * ESACM32 ) + VGHAT0A = DCONST3A * ( ESAC16 + BHAT * KNACC * ESAC04 ) + VGHAT2A = DCONST3A * ( ESAC48 + BHAT * KNACC * ESAC20 ) + VGHAT3A = DCONST3A * ( ESAC64 + BHAT * KNACC * ESAC28 ) + +C coarse mode + DCHAT0C = DCONST1C * ( ESCO04 + BHAT * KNCOR * ESCO16 ) + DCHAT2C = DCONST1C * ( ESCOM12 + BHAT * KNCOR * ESCOM16 ) + DCHAT3C = DCONST1C * ( ESCOM20 + BHAT * KNCOR * ESCOM32 ) + VGHAT0C = DCONST3C * ( ESCO16 + BHAT * KNCOR * ESCO04 ) + VGHAT2C = DCONST3C * ( ESCO48 + BHAT * KNCOR * ESCO20 ) + VGHAT3C = DCONST3C * ( ESCO64 + BHAT * KNCOR * ESCO28 ) + +C now calculate the deposition velocities + + NU = AMU( C,R ) / BLKDENS( C,R ) + USTFAC = BLKUSTAR( C,R ) * BLKUSTAR( C,R ) / ( GRAV * NU ) + STOKEN = DCONST3N * USTFAC + STOKEA = DCONST3A * USTFAC + STOKEC = DCONST3C * USTFAC + UTSCALE = BLKUSTAR( C,R ) + & + 0.24 * BLKWSTAR( C,R ) * BLKWSTAR( C,R ) + & / BLKUSTAR( C,R ) + +C first do 0th moment for the deposition of number + +C Aitken mode + SC0N = NU / DCHAT0N + EIM = STOKEN ** 2 / 400.0 * ESAT64 + EIM = MIN( EIM, 1.0 ) + RD0N = 1.0 / ( UTSCALE * ( SC0N ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDNATK ) = VGHAT0N + & / ( 1.0 - EXP( -VGHAT0N * ( BLKRA( C,R ) + RD0N ) ) ) + +C accumulation mode + SC0A = NU / DCHAT0A + EIM = STOKEA ** 2 / 400.0 * ESAC64 + EIM = MIN( EIM, 1.0 ) + RD0A = 1.0 / ( UTSCALE * ( SC0A ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDNACC ) = VGHAT0A + & / ( 1.0 - EXP( -VGHAT0A * ( BLKRA( C,R ) + RD0A ) ) ) + +C coarse mode + SC0C = NU / DCHAT0C + EIM = STOKEC ** 2 / 400.0 * ESCO64 + EIM = MIN( EIM, 1.0 ) + RD0C = 1.0 / ( UTSCALE * ( SC0C ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDNCOR ) = VGHAT0C + & / ( 1.0 - EXP( -VGHAT0C * ( BLKRA( C,R ) + RD0C ) ) ) + +C now do 2nd moment for the deposition of surface area + +C Aitken mode + SC2N = NU / DCHAT2N + EIM = STOKEN ** 2 / 400.0 * ESAT128 + EIM = MIN( EIM, 1.0 ) + RD2N = 1.0 / ( UTSCALE * ( SC2N ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDSATK ) = VGHAT2N + & / ( 1.0 - EXP( -VGHAT2N * ( BLKRA( C,R ) + RD2N ) ) ) + +C accumulation mode + SC2A = NU / DCHAT2A + EIM = STOKEA ** 2 / 400.0 * ESAC128 + EIM = MIN( EIM, 1.0 ) + RD2A = 1.0 / ( UTSCALE * ( SC2A ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDSACC ) = VGHAT2A + & / ( 1.0 - EXP( -VGHAT2A * ( BLKRA( C,R ) + RD2A ) ) ) + +C coarse mode + SC2C = NU / DCHAT2C + EIM = STOKEC ** 2 / 400.0 * ESCO128 + EIM = MIN( EIM, 1.0 ) + RD2C = 1.0 / ( UTSCALE * ( SC2C ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDSCOR ) = VGHAT2C + & / ( 1.0 - EXP( -VGHAT2C * ( BLKRA( C,R ) + RD2C ) ) ) + +C now do 3rd moment for the deposition of mass + +C Aitken mode + SC3N = NU / DCHAT3N + EIM = STOKEN ** 2 / 400.0 * ESAT160 + EIM = MIN( EIM, 1.0 ) + RD3N = 1.0 / ( UTSCALE * ( SC3N ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDMATK ) = VGHAT3N + & / ( 1.0 - EXP( -VGHAT3N * ( BLKRA( C,R ) + RD3N ) ) ) + +C accumulation mode + SC3A = NU / DCHAT3A + EIM = STOKEA ** 2 / 400.0 * ESAC160 + EIM = MIN( EIM, 1.0 ) + RD3A = 1.0 / ( UTSCALE * ( SC3A ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDMACC ) = VGHAT3A + & / ( 1.0 - EXP( -VGHAT3A * ( BLKRA( C,R ) + RD3A ) ) ) + +C coarse mode + SC3C = NU / DCHAT3C + EIM = STOKEC ** 2 / 400.0 * ESCO160 + EIM = MIN( EIM, 1.0 ) + RD3C = 1.0 / ( UTSCALE * ( SC3C ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDMCOR ) = VGHAT3C + & / ( 1.0 - EXP( -VGHAT3C * ( BLKRA( C,R ) + RD3C ) ) ) + +C Do mosaic calculations - essentially a repeat of the above, using the mosaic vars + IF ( MOSAIC ) THEN + + DO J = 1, N_LUFRAC + IF ( BLKRAJ( J,C,R ) .GT. 0.0 ) THEN + +C now calculate the deposition velocities + + NU = AMU( C,R ) / BLKDENS( C,R ) + USTFAC = BLKUSTARJ( J,C,R ) * BLKUSTARJ( J,C,R ) / ( GRAV * NU ) + STOKEN = DCONST3N * USTFAC + STOKEA = DCONST3A * USTFAC + STOKEC = DCONST3C * USTFAC + UTSCALE = BLKUSTARJ( J,C,R ) + & + 0.24 * BLKWSTAR( C,R ) * BLKWSTAR( C,R ) + & / BLKUSTARJ( J,C,R ) + +C first do 0th moment for the deposition of number + +C Aitken mode + + SC0N = NU / DCHAT0N + EIM = STOKEN ** 2 / 400.0 * ESAT64 + EIM = MIN( EIM, 1.0 ) + RD0N = 1.0 / ( UTSCALE * ( SC0N ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDNATK ) = VGHAT0N + & / ( 1.0 - EXP(-VGHAT0N * ( BLKRAJ( J,C,R ) + RD0N ) ) ) + +C accumulation mode + + SC0A = NU / DCHAT0A + EIM = STOKEA ** 2 / 400.0 * ESAC64 + EIM = MIN( EIM, 1.0 ) + RD0A = 1.0 / ( UTSCALE * ( SC0A ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDNACC ) = VGHAT0A + & / ( 1.0 - EXP(-VGHAT0A * ( BLKRAJ( J,C,R ) + RD0A ) ) ) + +C coarse mode + + SC0C = NU / DCHAT0C + EIM = STOKEC ** 2 / 400.0 * ESCO64 + EIM = MIN( EIM, 1.0 ) + RD0C = 1.0 / ( UTSCALE * ( SC0C ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDNCOR ) = VGHAT0C + & / ( 1.0 - EXP(-VGHAT0C * ( BLKRAJ( J,C,R ) + RD0C ) ) ) + +C now do 2nd moment for the deposition of surface area + +C Aitken mode + + SC2N = NU / DCHAT2N + EIM = STOKEN ** 2 / 400.0 * ESAT128 + EIM = MIN( EIM, 1.0 ) + RD2N = 1.0 / ( UTSCALE * ( SC2N ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDSATK ) = VGHAT2N + & / ( 1.0 - EXP(-VGHAT2N * ( BLKRAJ( J,C,R ) + RD2N ) ) ) + +C accumulation mode + + SC2A = NU / DCHAT2A + EIM = STOKEA ** 2 / 400.0 * ESAC128 + EIM = MIN( EIM, 1.0 ) + RD2A = 1.0 / ( UTSCALE * ( SC2A ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDSACC ) = VGHAT2A + & / ( 1.0 - EXP(-VGHAT2A * ( BLKRAJ( J,C,R ) + RD2A ) ) ) + +C coarse mode + + SC2C = NU / DCHAT2C + EIM = STOKEC ** 2 / 400.0 * ESCO128 + EIM = MIN( EIM, 1.0 ) + RD2C = 1.0 / ( UTSCALE * ( SC2C ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDSCOR ) = VGHAT2C + & / ( 1.0 - EXP(-VGHAT2C * ( BLKRAJ( J,C,R ) + RD2C ) ) ) + +C now do 3rd moment for the deposition of mass + +C Aitken mode + + SC3N = NU / DCHAT3N + EIM = STOKEN ** 2 / 400.0 * ESAT160 + EIM = MIN( EIM, 1.0 ) + RD3N = 1.0 / ( UTSCALE * ( SC3N ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDMATK ) = VGHAT3N + & / ( 1.0 - EXP(-VGHAT3N * ( BLKRAJ( J,C,R ) + RD3N ) ) ) + +C accumulation mode + + SC3A = NU / DCHAT3A + EIM = STOKEA ** 2 / 400.0 * ESAC160 + EIM = MIN( EIM, 1.0 ) + RD3A = 1.0 / ( UTSCALE * ( SC3A ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDMACC ) = VGHAT3A + & / ( 1.0 - EXP(-VGHAT3A * ( BLKRAJ( J,C,R ) + RD3A ) ) ) + +C coarse mode + + SC3C = NU / DCHAT3C + EIM = STOKEC ** 2 / 400.0 * ESCO160 + EIM = MIN( EIM, 1.0 ) + RD3C = 1.0 / ( UTSCALE * ( SC3C ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDMCOR ) = VGHAT3C + & / ( 1.0 - EXP(-VGHAT3C * ( BLKRAJ( J,C,R ) + RD3C ) ) ) + + END IF ! RAJ > 0 + + END DO ! n_lufrac + + END IF ! mosaic + END DO ! end loop on C + END DO ! end loop on R + + RETURN + END SUBROUTINE GETDEP_V diff --git a/models/CCTM/aero/aero_noop/aero_noop.F b/models/CCTM/aero/aero_noop/aero_noop.F new file mode 100755 index 0000000..d5a6646 --- /dev/null +++ b/models/CCTM/aero/aero_noop/aero_noop.F @@ -0,0 +1,67 @@ + +C*********************************************************************** +C Portions of Models-3/CMAQ software were developed or based on * +C information from various groups: Federal Government employees, * +C contractors working on a United States Government contract, and * +C non-Federal sources (including research institutions). These * +C research institutions have given the Government permission to * +C use, prepare derivative works, and distribute copies of their * +C work in Models-3/CMAQ to the public and to permit others to do * +C so. EPA therefore grants similar permissions for use of the * +C Models-3/CMAQ software, but users are requested to provide copies * +C of derivative works to the Government without restrictions as to * +C use by others. Users are responsible for acquiring their own * +C copies of commercial software associated with Models-3/CMAQ and * +C for complying with vendor requirements. Software copyrights by * +C the MCNC Environmental Modeling Center are used with their * +C permissions subject to the above restrictions. * +C*********************************************************************** + +C RCS file, release, date & time of last delta, author, state, [and locker] +C $Header: /Volumes/Data/CVS/CMAQ_CVSrepos/CCTM/src/aero/aero_noop/aero_noop.F,v 1.1.1.1 2010/06/14 16:03:00 sjr Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C @(#)aero_driver_noop.F 1.1 /project/mod3/CMAQ/src/aero/aero_noop/SCCS/s.aero_driver_noop.F 13 Jun 1997 12:25:54 + +C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE AERO ( CGRID, JDATE, JTIME, TSTEP ) + +C 31 Mar 01 J.Young: generic CGRID declaration + + IMPLICIT NONE + +C Includes: + +! INCLUDE SUBST_HGRD_ID ! horizontal dimensioning parameters +! INCLUDE SUBST_VGRD_ID ! vertical dimensioning parameters +! INCLUDE SUBST_IODECL ! I/O definitions and declarations + +c Arguments + +C CGRID is incoming conc field (both gas and aerosol variables) + +! REAL :: CGRID( :,:,:,: ) ! concentrations + REAL, POINTER :: CGRID( :,:,:,: ) ! concentrations + INTEGER JDATE ! current model date, coded YYYYDDD + INTEGER JTIME ! current model time, coded HHMMSS + INTEGER TSTEP( 2 ) ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + ! TSTEP(2) = sciproc sync. step (chem) + +C Local variables: + + LOGICAL, SAVE :: FIRSTIME = .TRUE. + INTEGER, SAVE :: LOGDEV + +C----------------------------------------------------------------------- + + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. +! LOGDEV = INIT3() +! WRITE( LOGDEV,* ) ' ' +! WRITE( LOGDEV,* ) ' Using no-op aerosol process' +! WRITE( LOGDEV,* ) ' ' + END IF + + RETURN + END diff --git a/models/CCTM/aero/aero_noop/getpar.f b/models/CCTM/aero/aero_noop/getpar.f new file mode 100755 index 0000000..990bd2e --- /dev/null +++ b/models/CCTM/aero/aero_noop/getpar.f @@ -0,0 +1,174 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/getpar.f,v 1.7 2012/01/19 13:13:27 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Subroutine getpar( m3_wet_flag, limit_sg ) + +C Calculates the 3rd moments (M3), masses, aerosol densities, and +C geometric mean diameters (Dg) of all 3 modes, and the natural logs of +C geometric standard deviations (Sg) of the Aitken and accumulation modes. + +C The input logical variable, M3_WET_FLAG, dictates whether the +C calculations in GETPAR are to assume that the aerosol is "wet" or +C "dry." In the present context, a "wet" aerosol consists of all +C chemical components of the aerosol. A "dry" aerosol excludes +C particle-bound water and also excludes secondary organic aerosol. + +C NOTE! 2nd moment concentrations (M2) are passed into GETPAR in the +C CBLK array and are modified within GETPAR only in the event that +C the Sg value of a given mode has gone outside of the acceptable +C range (1.05 to 2.50). The GETPAR calculations implicitly assume +C that the input value of M2 is consistent with the input value of +C M3_WET_FLAG. If, for example, the input M2 value was calculated +C for a "dry" aerosol and the M3_WET_FLAG is .TRUE., GETPAR would +C incorrectly adjust the M2 concentrations! + +C +C SH 03/10/11 Renamed met_data to aeromet_data +C----------------------------------------------------------------------- + + Use aero_data + Use aeromet_data ! Includes CONST.EXT + + Implicit None + +C Arguments: + Logical, Intent( In ) :: m3_wet_flag ! true = include H2O and SOA in 3rd moment + ! false = exclude H2O and SOA from 3rd moment + + Logical, Intent( In ) :: limit_sg ! fix coarse and accum Sg's to the input value? + +C Output variables: +C updates arrays in aero_data module +C moment3_conc 3rd moment concentration [ ug /m**3 ] +C aeromode_mass mass concentration: [ ug / m**3 ] +C aeromode_dens avg particle density [ kg / m**3 ] +C aeromode_diam geometric mean diameter [ m ] +C aeromode_sdev log of geometric standard deviation + +C Local Variables: + Real( 8 ) :: xxm0 ! temporary storage of moment 0 conc's + Real( 8 ) :: xxm2 ! temporary storage of moment 2 conc's + Real( 8 ) :: xxm3 ! temporary storage of moment 3 conc's + Real( 8 ) :: xfsum ! (ln(M0)+2ln(M3))/3; used in Sg calcs + Real( 8 ) :: lxfm2 ! ln(M2); used in Sg calcs + Real( 8 ) :: l2sg ! square of ln(Sg); used in diameter calcs + Real :: es36 ! exp(4.5*l2sg); used in diameter calcs + Real :: m3augm ! temp variable for wet 3rd moment calcs + + Real( 8 ), Parameter :: one3d = 1.0D0 / 3.0D0 + Real( 8 ), Parameter :: two3d = 2.0D0 / 3.0D0 + + Real, Parameter :: one3 = 1.0 / 3.0 + Real, Parameter :: dgmin = 1.0E-09 ! minimum particle diameter [ m ] + Real, Parameter :: densmin = 1.0E03 ! minimum particle density [ kg/m**3 ] + + Real( 8 ) :: minl2sg( n_mode ) ! min value of ln(sg)**2 for each mode + Real( 8 ) :: maxl2sg( n_mode ) ! max value of ln(sg)**2 for each mode + + Real :: factor + Real( 8 ) :: sumM3 + Real( 8 ) :: sumMass + Integer :: n, spc ! loop counters + +C----------------------------------------------------------------------- + +C *** Set bounds for ln(Sg)**2 + + Do n = 1 , n_mode + If ( limit_sg ) Then + minl2sg( n ) = aeromode_sdev( n ) ** 2 + maxl2sg( n ) = aeromode_sdev( n ) ** 2 + Else + minl2sg( n ) = Log( min_sigma_g ) ** 2 + maxl2sg( n ) = Log( max_sigma_g ) ** 2 + End If + End Do + +C *** Calculate aerosol 3rd moment concentrations [ m**3 / m**3 ] + + Do n = 1, n_mode + sumM3 = 0.0 + sumMass = 0.0 + + Do spc = 1, n_aerospc + If ( aerospc( spc )%tracer ) Cycle + If ( aerospc( spc )%name( n ) .eq. ' ' ) Cycle + + If ( .Not. aerospc( spc )%no_M2Wet .Or. m3_wet_flag ) Then + factor = 1.0E-9 * f6pi / aerospc( spc )%density + sumM3 = sumM3 + factor * aerospc_conc( spc,n ) + sumMass = sumMass + aerospc_conc( spc,n ) + End If + End Do + + moment3_conc( n ) = Max (sumM3, Real( aeromode( n )%min_m3conc, 8 ) ) + aeromode_mass( n ) = sumMass + End Do + +C *** Calculate modal average particle densities [ kg/m**3 ] + + Do n = 1, n_mode + aeromode_dens( n ) = Max( densmin, + & 1.0E-9 * f6pi * aeromode_mass( n ) / moment3_conc( n ) ) + End Do + +C *** Calculate geometric standard deviations as follows: +c ln^2(Sg) = 1/3*ln(M0) + 2/3*ln(M3) - ln(M2) +c NOTES: +c 1. Equation 10-5a of [Binkowski:1999] and Equation 5a of +c Binkowski&Roselle(2003) contain typographical errors. +c 2. If the square of the logarithm of the geometric standard +c deviation is out of an acceptable range, reset this value and +c adjust the second moments to be consistent with this value. +c In this manner, M2 is artificially increased when Sg exceeds +c the maximum limit. M2 is artificially decreased when Sg falls +c below the minimum limit. + +C *** Aitken Mode: + + Do n = 1, n_mode + xxm0 = moment0_conc( n ) + xxm2 = moment2_conc( n ) + xxm3 = moment3_conc( n ) + + xfsum = one3d * Log( xxm0 ) + two3d * Log( xxm3 ) + + lxfm2 = Log( xxm2 ) + l2sg = xfsum - lxfm2 + + l2sg = Max( l2sg, minl2sg( n ) ) + l2sg = Min( l2sg, maxl2sg( n ) ) + + lxfm2 = xfsum - l2sg + moment2_conc( n ) = Exp ( lxfm2 ) + aeromode_sdev( n ) = Sqrt( l2sg ) + + ES36 = Exp( 4.5 * l2sg ) + aeromode_diam( n ) = Max( dgmin, ( moment3_conc( n ) + & / ( moment0_conc( n ) * es36 ) ) ** one3 ) + + End Do + + Return + End Subroutine getpar + diff --git a/models/CCTM/aero/blank/AEROMET_DATA.F b/models/CCTM/aero/blank/AEROMET_DATA.F new file mode 100755 index 0000000..e77da3d --- /dev/null +++ b/models/CCTM/aero/blank/AEROMET_DATA.F @@ -0,0 +1,59 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/AEROMET_DATA.F,v 1.6 2012/01/19 13:10:03 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module aeromet_data + +C Some parameters and meteorological variables required in aerosol +C processing. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 renamed file and module from MET_DATA to AEROMET_DATA +C---------------------------------------------------------------------- + + Implicit None + +C Fundamental constants + Include SUBST_CONST ! common constants + + Real( 8 ), Parameter :: f6dpi = 6.0D0 / dpi + Real, Parameter :: f6pi = 6.0 / pi + Real( 8 ), Parameter :: dpi6 = dpi / 6.0D0 + Real, Parameter :: pi6 = pi / 6.0 + Real( 8 ), Parameter :: boltzmann = rgasuniv / avo ! [ J/K ] + +C Concentration lower limit used for gas species + Real, Parameter :: min_gasconc = 1.0E-30 ! [ ug/m^3 ] + +C Meteorological variables (data from MET_CRO_3D file) + Real :: airtemp ! air temp [ K ] + Real :: airpres ! air pressure [ Pa] + Real :: airdens ! air density [ kg/m^3] + Real :: airRH ! fractional relative humidity + Real :: airQV ! water vapor mass mixing ratio [ kg_H2O/kg_air ] + Real :: H2OsatVP ! saturation water vapor pressure [ Pa ] + Real :: H2OVP ! ambient water vapor pressure [ Pa ] + + End Module aeromet_data diff --git a/models/CCTM/aero/blank/AERO_DATA.F b/models/CCTM/aero/blank/AERO_DATA.F new file mode 100755 index 0000000..8a96fa5 --- /dev/null +++ b/models/CCTM/aero/blank/AERO_DATA.F @@ -0,0 +1,657 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/AERO_DATA.F,v 1.11 2011/10/21 16:10:02 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module aero_data + +C Defines aerosol species arrays and the parameters required in aerosol +C processing. +C +C Contains: +C Subroutine map_aero +C Subroutine extract_aero +C Subroutine update_aero +C Function findAero +C +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Inserted functionality of PMEM_DEFN +C -new subroutine map_pmemis +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C SH 04/04/11 Added sea-salt speciation factors +C +C---------------------------------------------------------------------- + + Implicit None + +C Number of aerosol species and modes + +C$$$ Integer, Parameter :: n_aerospc = 30 ! number of aero species + Integer, Parameter :: n_aerospc = 1 ! number of aero species + Integer, Parameter :: n_mode = 3 ! number of modes: + ! 1 = Aitken + ! 2 = accumulation + ! 3 = coarse + +C Define Logical values as T and F + Logical, Parameter, Private :: T = .true. + Logical, Parameter, Private :: F = .false. + + +C Default minimum concentration + Real, Parameter :: conmin = 1.0E-30 ! [ ug/m^3 ] + Real, Parameter :: conmin_set( n_mode ) = (/conmin, conmin, conmin/) + Real, Parameter :: conmin_so4( n_mode ) = (/1.0E-12,1.0E-6, conmin/) + Real, Parameter :: conmin_cor( n_mode ) = (/conmin, conmin, 1.889544E-05/) + + +C Flag to obtain coagulation coefficients +C by analytical approximation (True) or by Gauss-Hermite quadrature (False) + Logical, Parameter :: fastcoag_flag = .True. + +C------------------------------------------------------------------------------------------------------- + + Type spcs_type + Character( 16 ) :: name( n_mode ) ! names of aerosol species for each mode + Real :: min_conc( n_mode ) ! minimum concentration values for each mode + Real :: density ! density [ kg/m^3 ] + Logical :: no_M2Wet ! flag to exclude from 2nd moment during transport + Logical :: nonVol_soa ! non-volatile SOA flag + Logical :: tracer ! tracer flag; does have not mass + Integer :: charge ! electroneutrality charge + Real :: visual_idx ! visual index factor + Character( 16 ) :: optic_surr ! optical surrogate name + Character( 16 ) :: emis ! anthropogenic PM emissions names + Real :: emis_split( n_mode ) ! minimum concentration values for each mode + End Type spcs_type + + Type( spcs_type ), Parameter :: aerospc( n_aerospc ) = (/ +C nonVolSOA +C | Charge Emissions +C -----------Name-------------- NoM2Wet |Tracer| ----Split Factor---- +C Aitken Accum Coarse Min_Concs Density | | | | Visidx OptSurr Emis Aitken Accum Coarse +C --------- --------- --------- ---------- ------- + + + + ----- -------- -------- ------ ------ ------ +C$$$ & spcs_type((/'ASO4I ','ASO4J ','ASO4K '/),conmin_so4, 1800.0, F, F, F, -2, 3.0,'SOLUTE','PSO4 ',(/0.000,1.000,0.000/)), +C$$$ & spcs_type((/'ANO3I ','ANO3J ','ANO3K '/),conmin_set, 1800.0, F, F, F, -1, 3.0,'SOLUTE','PNO3 ',(/0.000,1.000,0.000/)), +C$$$ & spcs_type((/'ACLI ','ACLJ ','ACLK '/),conmin_set, 2200.0, F, F, F, -1, 0.0,'SOLUTE',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/'ANH4I ','ANH4J ','ANH4K '/),conmin_set, 1800.0, F, F, F, 1, 3.0,'SOLUTE',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/'ANAI ','ANAJ ','ANAK '/),conmin_set, 2200.0, F, F, F, 1, 0.0,'SOLUTE',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/'AORGPAI','AORGPAJ',' '/),conmin_set, 2000.0, F, F, F, 0, 4.0,'DUST ','POC ',(/0.001,0.999,0.000/)), +C$$$ & spcs_type((/'AECI ','AECJ ',' '/),conmin_set, 2200.0, F, F, F, 0, 10.0,'SOOT ','PEC ',(/0.001,0.999,0.000/)), + & spcs_type((/'AH2OI ','AH2OJ ','AH2OK '/),conmin_set, 1000.0, T, F, F, 0, 0.0,'WATER ',' ',(/0.000,0.000,0.000/))/) +C$$$ & spcs_type((/'A25I ','A25J ',' '/),conmin_set, 2200.0, F, F, F, 0, 1.0,'DUST ','PMFINE',(/0.000,1.000,0.000/)), +C$$$ & spcs_type((/' ','AALKJ ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AXYL1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AXYL2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AXYL3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATOL1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATOL2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATOL3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ABNZ1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ABNZ2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ABNZ3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATRP1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ATRP2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AISO1J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AISO2J ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AISO3J ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','ASQTJ ',' '/),conmin_set, 2000.0, T, F, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AOLGAJ ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AOLGBJ ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ','AORGCJ ',' '/),conmin_set, 2000.0, F, T, F, 0, 4.0,'DUST ',' ',(/0.000,0.000,0.000/)), +C$$$ & spcs_type((/' ',' ','ASOIL '/),conmin_set, 2600.0, F, F, F, 0, 0.0,'DUST ',' ',(/0.000,0.000,0.000/))/) +C$$$ & spcs_type((/' ',' ','ACORS '/),conmin_cor, 2200.0, F, F, F, 0, 0.0,'DUST ','PMC ',(/0.000,0.000,1.000/))/) + +C Sea-Salt Speciation factors +C NOTE: in SSEMIS.F, all sea-salt emissions are assumed to be in the accumulation +C and coarse modes + Real, Parameter :: aerospc_ssf( n_mode, n_aerospc) = Reshape ( +C Aitken Accum Coarse +C - ------ ------- ------- +C$$$ & (/ 0.0, 0.0755, 0.0755, ! ASO4 +C$$$ & 0.0, 0.0, 0.0, ! ANO3 +C$$$ & 0.0, 0.5389, 0.5389, ! ACL +C$$$ & 0.0, 0.0, 0.0, ! ANH4 +C$$$ & 0.0, 0.3856, 0.3856, ! ANA +C$$$ & 0.0, 0.0, 0.0, ! AORGPA +C$$$ & 0.0, 0.0, 0.0, ! AEC + & (/ 0.0, 0.0, 0.0 /), ! AH2O +C$$$ & 0.0, 0.0, 0.0, ! A25 +C$$$ & 0.0, 0.0, 0.0, ! AALK +C$$$ & 0.0, 0.0, 0.0, ! AXYL1 +C$$$ & 0.0, 0.0, 0.0, ! AXYL2 +C$$$ & 0.0, 0.0, 0.0, ! AXYL3 +C$$$ & 0.0, 0.0, 0.0, ! ATOL1 +C$$$ & 0.0, 0.0, 0.0, ! ATOL2 +C$$$ & 0.0, 0.0, 0.0, ! ATOL3 +C$$$ & 0.0, 0.0, 0.0, ! ABNZ1 +C$$$ & 0.0, 0.0, 0.0, ! ABNZ2 +C$$$ & 0.0, 0.0, 0.0, ! ABNZ3 +C$$$ & 0.0, 0.0, 0.0, ! ATRP1 +C$$$ & 0.0, 0.0, 0.0, ! ATRP2 +C$$$ & 0.0, 0.0, 0.0, ! AISO1 +C$$$ & 0.0, 0.0, 0.0, ! AISO2 +C$$$ & 0.0, 0.0, 0.0, ! AISO3 +C$$$ & 0.0, 0.0, 0.0, ! ASQT +C$$$ & 0.0, 0.0, 0.0, ! AOLGA +C$$$ & 0.0, 0.0, 0.0, ! AOLGB +C$$$ & 0.0, 0.0, 0.0, ! AORGC +C$$$ & 0.0, 0.0, 0.0 /), ! ASOIL +C$$$ & 0.0, 0.0, 0.0 /), ! ACORS + & (/ n_mode,n_aerospc /), Order = (/ 1,2 /) ) + +C Required species + Character( 16 ), Private, Parameter :: req_so4 = 'ASO4' + Character( 16 ), Private, Parameter :: req_nh4 = 'ANH4' + Character( 16 ), Private, Parameter :: req_no3 = 'ANO3' + Character( 16 ), Private, Parameter :: req_orgpa = 'AORGPA' + Character( 16 ), Private, Parameter :: req_na = 'ANA' + Character( 16 ), Private, Parameter :: req_cl = 'ACL' + Character( 16 ), Private, Parameter :: req_h2o = 'AH2O' + Character( 16 ), Private, Parameter :: req_soil = 'ASOIL' + Character( 16 ), Private, Parameter :: req_cors = 'ACORS' + +C Indexes of required species + Integer :: aso4_idx + Integer :: anh4_idx + Integer :: ano3_idx + Integer :: apoc_idx + Integer :: ana_idx + Integer :: acl_idx + Integer :: ah2o_idx + Integer :: asoil_idx + Integer :: acors_idx + +C Index required for compilation only, but not used in aero5 + Integer :: apncom_idx + +C Molecular weights and concentrations of aerosol species + Real :: aerospc_mw( n_aerospc ) ! aero species M.W. (from AE_SPC.EXT) [ g/mol ] + Real :: aerospc_conc( n_aerospc,n_mode ) ! aero species concentration [ ug/m^3 ] + +C Common factors + Real( 8 ) :: h2ofac ! converts mass concentrations [ug/m3] to 3rd moment concentrations [m3/m3] + +C------------------------------------------------------------------------------------------------------- + + Type mode_type + Character( 16 ) :: num_name ! name of aerosol number variable + Character( 16 ) :: srf_name ! name of aerosol surface area variable + Real :: min_numconc ! minimum number concentration + Real :: min_m2conc ! minimum 2nd moment concentration + Real :: min_m3conc ! minimum 3rd moment concentration + End Type mode_type + + Type ( mode_type ), Parameter :: aeromode( n_mode ) = (/ +C number surface minimum minimum minimum +C name name numconc m2conc m3conc +C ---------- ------- -------- ------- ------ + & mode_type('NUMATKN', 'SRFATKN', conmin, conmin, conmin), + & mode_type('NUMACC ', 'SRFACC ', conmin, conmin, conmin), + & mode_type('NUMCOR ', 'SRFCOR ', conmin, conmin, conmin)/) + + Real, Parameter :: min_sigma_g = 1.05 + Real, Parameter :: max_sigma_g = 2.50 + Real, Parameter :: def_sigma_g( n_mode ) = (/ 1.70, 2.0, 2.2 /) ! background sigma-G for each mode + Real, Parameter :: def_diam( n_mode ) = (/ 1.0E-8, 7.0E-8, 1.0E-6 /) ! background mean diameter for each mode + + Real :: moment0_conc( n_mode ) ! 0th moment concentration + Real :: moment2_conc( n_mode ) ! 2nd moment concentration + Real :: moment3_conc( n_mode ) ! 3rd moment concentration + +C Mass concentration (calculated by GETPAR) + Real :: aeromode_mass( n_mode ) ! [ ug/m^3 ] + +C Particle density (calculated by GETPAR) + Real :: aeromode_dens( n_mode ) ! [ kg/m^3 ] + +C Geometric mean diameter (calculated by GETPAR) + Real :: aeromode_diam( n_mode ) ! [ m ] + +C Log of geometric standard deviation (calculated by GETPAR ) + Real :: aeromode_sdev( n_mode ) + +C Minimum number (calculated in map_aero routine) + Real :: aeromode_minNum( n_mode ) = 1.e-30 + +C Minimum 2nd moment (calculated in map_aero routine) + Real :: aeromode_minM2( n_mode ) + +C Mapping for loading from and unloading to CGRID array + Integer :: aerospc_map( n_aerospc,n_mode ) ! indices of aero species to CGRID + Integer :: aeronum_map( n_mode ) ! indices of aero number variable to CGRID + Integer :: aerosrf_map( n_mode ) ! indices of aero surf area variable to CGRID + +C Emissions mapping + Integer :: n_emis_pm ! number of aerospc with emissions + Integer :: pmem_map( n_aerospc ) ! mapping to aerospc array for PM emissions + Character( 16 ) :: pmem_units ! units for PM emissions for all species + +C Private variables for loading from and unloading to CGRID array + Logical, Private, Save :: mapped = .False. + Character( 16 ), Private, Save :: pname = 'Aero_Data' + + Contains + +C----------------------------------------------------------------------- + Subroutine map_aero() + +C Defines aerosol mapping from CGRID for species concentration and moments. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Use cgrid_spcs ! CGRID mechanism species + Use aeromet_data + Use utilio_defn + + Implicit None + +C Local Variables: + Character( 80 ) :: xmsg + Integer m, n, spc + Real so4fac + Real anthfac + + if ( .Not. mapped ) Then + aerospc_mw = 0.0 + aerospc_map = 0 + +C build mapping to CGRID for each aero spc + Do m = 1, n_mode + Do spc = 1, n_aerospc + If ( aerospc( spc )%name( m ) .Ne. ' ' ) Then + n = index1( aerospc( spc )%name( m ), n_ae_spc, ae_spc ) + If ( n .Eq. 0 ) Then + xmsg = 'Species '// aerospc(spc)%name( m ) // ' in aerospc name is not in AE_SPC' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + aerospc_map( spc,m ) = ae_strt - 1 + n + If ( aerospc_mw( spc ) .Lt. 0.5 ) Then ! mw=0 means a new species + aerospc_mw( spc ) = ae_molwt( n ) + Else If ( aerospc_mw( spc ) .Ne. ae_molwt( n ) ) Then + xmsg = 'molecular weight of ' // Trim( aerospc( spc )%name( m ) ) + & // ' is different from that of the same species' + & // ' in the same or another mode.' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End If + End Do + End Do + +C Build mapping to CGRID for aero # and surf area variables + aeronum_map = 0 + aerosrf_map = 0 + + Do m = 1, n_mode + n = index1( aeromode( m )%num_name, n_ae_spc, ae_spc ) + If ( n .Eq. 0 ) Then + xmsg = 'Species ' // Trim( aeromode( m )%num_name ) + & //' in aeronum name is not in AE_SPC' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + Else + aeronum_map( m ) = ae_strt - 1 + n + End If + + n = index1( aeromode( m )%srf_name, n_ae_spc, ae_spc ) + If ( n .Eq. 0 ) Then + xmsg = 'species ' // Trim( aeromode( m )%srf_name ) + & // ' in aerosrf name is not in AE_SPC' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + Else + aerosrf_map( m ) = ae_strt - 1 + n + End If + End Do + +C Find indices of required species +C$$$ aso4_idx = findAero( req_so4, .True. ) +C$$$ anh4_idx = findAero( req_nh4, .True. ) +C$$$ ano3_idx = findAero( req_no3, .True. ) +C$$$ apoc_idx = findAero( req_orgpa, .True. ) +C$$$ ana_idx = findAero( req_na, .True. ) +C$$$ acl_idx = findAero( req_cl, .True. ) + ah2o_idx = findAero( req_h2o, .True. ) +C$$$ asoil_idx = findAero( req_soil, .True. ) +C$$$ acors_idx = findAero( req_cors, .True. ) + +C Compute common factors + h2ofac = 1.0D-9 * f6dpi / Real( aerospc( 1000.0 )%density, 8 ) + +C compute aeromode_minNum and aeromode_minM2 +C$$$ so4fac = 1.0E-9 * f6dpi / aerospc( aso4_idx )%density +C$$$ anthfac = 1.0E-9 * f6dpi / aerospc( acors_idx )%density + + Do m = 1, n_mode +C$$$ If( m .Lt. n_mode ) Then +C$$$ aeromode_minNum( m ) = so4fac * aerospc( aso4_idx )%min_conc( m ) / +C$$$ & ( def_diam( m )**3 * Exp( 4.5 * Log( def_sigma_g( m ) )**2 ) ) +C$$$ Else +C$$$ aeromode_minNum( m ) = anthfac * aerospc( acors_idx )%min_conc(m) / +C$$$ & ( def_diam( m )**3 * Exp( 4.5 * Log( def_sigma_g( m ) )**2 ) ) +C$$$ End If + + aeromode_minM2( m ) = aeromode_minNum( m ) * def_diam(m)**2 * + & Exp( 2.0 * Log( def_sigma_g(m) )**2 ) + End do + + mapped = .True. + + End If ! Not mapped + + Return + End Subroutine map_aero + + +C----------------------------------------------------------------------- + Subroutine map_pmemis ( ) +C +C Set the emissions units from the header of EMIS_1 file +C verify that all the units are consistent + + Use utilio_defn + + Implicit None + + Include SUBST_FILES_ID ! file name parameters + + ! Parameters: + Character( 10 ), Parameter :: blank10 = ' ' + + ! Local Variables: + Character( 16 ), Save :: pname = 'map_pmemis' + Character( 512 ) :: xmsg1 + Character( 1024 ) :: xmsg2 + Character( 10 ) :: units + + Integer :: indx + Integer :: v + Logical :: found + Logical :: match + + Logical, Save :: pm_mapped = .False. + +C only create mapping on first call + If ( pm_mapped ) Return + +C Call routine to map aerosol species array + If ( .Not. mapped ) Call map_aero ( ) + +C Open the gridded emissions file, which contains gas, aerosol, and non-reactive +C species + + If ( .Not. open3( emis_1, fsread3, pname ) ) Then + xmsg1 = 'Could not open '// emis_1 // ' file' + Call m3exit( pname, 0, 0, Trim( xmsg1 ), xstat1 ) + End If + + If ( .Not. desc3( emis_1 ) ) Then + xmsg1 = 'Could not get '// 'EMIS_1' // ' file description' + Call m3exit( pname, 0, 0, Trim( xmsg1 ), xstat2 ) + End If + +C Search emissions file for emission species names. Verify that their units +C are the same and set pmem_units + + n_emis_pm = 0 + pmem_units = 'null' + found = .True. + match = .True. + xmsg1 = 'Could not find the following species in emissions file' + xmsg2 = 'PM Units not uniform in EMIS_1 file.' + + Do v = 1, n_aerospc + If( aerospc( v )%emis .Ne. ' ' ) Then + n_emis_pm = n_emis_pm + 1 + pmem_map( n_emis_pm ) = v + + indx = index1( aerospc( v )%emis, nvars3d, vname3d ) + If ( indx .Le. 0 ) Then + xmsg1 = Trim( xmsg1 ) // crlf() // blank10 + & // Trim( aerospc( v )%emis ) + found = .False. + Cycle + End If + + ! change UNITS to upper case + units = units3d( indx ) + Call upcase( units ) + + !! save units on first emissions + If( pmem_units .Eq. 'null' ) pmem_units = units + + !! check that all emissions units match + If( pmem_units .Ne. units ) match = .False. + + !! build error message to use if mismatch + xmsg2 = Trim( xmsg2 ) // crlf() // blank10 + & // Trim( aerospc( v )%emis ) + & // '(' // Trim( units3d( indx ) ) // ')' + End If + End Do + +C if emission species not found throw error + If ( .Not. found ) Then + Call m3exit( pname, 0, 0, Trim( xmsg1 ), xstat2 ) + End If + +C if Units mismatch throw error + If ( .Not. match ) Then + Call m3exit( pname, 0, 0, Trim( xmsg2 ), xstat2 ) + End If + + pm_mapped = .True. + + Return + + End Subroutine map_pmemis + + +C----------------------------------------------------------------------- + Subroutine extract_aero( conc, minchk ) + +C Extracts the required aerosol data from CGRID into conc. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Implicit None + +C Arguments: + Real, Intent( In ) :: conc( : ) + Logical, Intent( In ) :: minchk + +C Local Variables: + Integer m, n, spc + + If ( .Not. mapped ) Then + Call map_aero() + End If + +C copy grid cell concentrations of aero species to aerospc_conc + aerospc_conc = 0.0 + If ( minchk ) Then + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .ne. 0 ) Then + aerospc_conc( spc,m ) = Max( conc( n ), aerospc( spc )%min_conc( m ) ) ! ug/m^3 + End If + End Do + End Do + Else + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .ne. 0 ) Then + aerospc_conc( spc,m ) = conc( n ) ! ug/m^3 + End If + End Do + End Do + End If + +C copy grid cell concentrations of aero # and surf area +C convert and assign to moment0_conc and moment2_conc + + moment0_conc = 0.0 + moment2_conc = 0.0 + + If ( minchk ) Then + Do m = 1, n_mode + n = aeronum_map( m ) + moment0_conc( m ) = Max( conc( n ), aeromode( m )%min_numconc ) + n = aerosrf_map( m ) + moment2_conc( m ) = Max( conc( n ), aeromode( m )%min_m2conc ) + End Do + Else + Do m = 1, n_mode + n = aeronum_map( m ) + moment0_conc( m ) = conc( n ) + n = aerosrf_map( m ) + moment2_conc( m ) = conc( n ) + End Do + End If + + Return + End Subroutine extract_aero + +C----------------------------------------------------------------------- + Subroutine update_aero( conc, minchk ) + +C Updates aerosol values in CGRID from the conc array. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Use aeromet_data !fundamental constants, data type definitions, etc. + Use utilio_defn + + Implicit None + +C arguments: + Real, Intent( Out ) :: conc( : ) + Logical, Intent( In ) :: minchk + +C local variables: + Character( 80 ) :: xmsg + Integer m, n, spc + + If ( .Not. mapped ) Then + xmsg = 'CGRID Species has not been mapped' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + +C Copy aerospc_conc back to grid cell concentrations + + If ( minchk ) Then + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .Ne. 0 ) Then + conc( n ) = Max( aerospc_conc( spc,m ), aerospc( spc )%min_conc( m ) ) + End If + End Do + End Do + Else + Do m = 1, n_mode + Do spc = 1, n_aerospc + n = aerospc_map( spc,m ) + If ( n .Ne. 0 ) Then + conc( n ) = aerospc_conc( spc,m ) + End If + End Do + End Do + End If + +C Copy aero number and surface area back to grid cell concentrations + + If ( minchk ) Then + Do m = 1, n_mode + n = aeronum_map( m ) + conc( n ) = Max( moment0_conc( m ), aeromode( m )%min_numconc ) + End Do + Else + Do m = 1, n_mode + n = aeronum_map( m ) + conc( n ) = moment0_conc( m ) + End Do + End If + + Do m = 1, n_mode + n = aerosrf_map( m ) + conc( n ) = pi * moment2_conc( m ) + End Do + + Return + End Subroutine update_aero + +C----------------------------------------------------------------------- + Integer Function findAero( vname, required ) Result ( idx ) + +C Finds the index of 'required' aerosol species in the aerospc list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C----------------------------------------------------------------------- + + Use utilio_defn + + Implicit None + +C Arguments: + Character( * ) :: vname + Logical :: required + +C Local Variables: + Character( 80 ) :: xmsg + Integer spc, n + + Do n = 1, n_mode + Do spc = 1, n_aerospc + If ( Index( aerospc( spc )%name( n ), Trim( vname ) ) .Gt. 0 ) Then + idx = spc + Return + End If + End Do + End Do + + If ( .Not. required ) Then + idx = 0 + Return + End If + + xmsg = 'Required Species ' // Trim( vname ) // ' Not found in aerospc names array' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + + Return + End Function findAero + + End Module aero_data + diff --git a/models/CCTM/aero/blank/AERO_EMIS.F b/models/CCTM/aero/blank/AERO_EMIS.F new file mode 100755 index 0000000..53eb5ed --- /dev/null +++ b/models/CCTM/aero/blank/AERO_EMIS.F @@ -0,0 +1,865 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/AERO_EMIS.F,v 1.8 2011/10/21 16:10:02 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE AERO_EMIS + +C Emissions data and code required for the modal aerosol module in CMAQ +C Based on original codes by Dr. Francis S. Binkowski and J. Young + +C Dependent Upon: NONE + +C Revision History: + +C 30 Aug 01 J.Young: dyn alloc - Use HGRD_DEFN +C 09 Oct 03 J.Gipson: added MW array for AE emis species to module contents +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module, GRID_CONF +C 26 Apr 05 P.Bhave: removed code supporting the "old type" of emission +C files that had unspeciated PM10 and PM2.5 only +C removed need for 'AERO_SPC.EXT' by declaring the +C required variables locally +C 13 Jun 05 P.Bhave: added vars needed for sea-salt emission processing +C inherit N_AE_EMIS,AE_EMIS,AE_EMIS_MAP from AE_EMIS.EXT +C moved RHO* parameters from RDEMIS_AE to this module +C for use by SSEMIS routine +C 24 Aug 07 J.Young: Modified to enable in-line plume rise calculation for +C 3D pt source emissions. Distinguish between PM (primary, +C unspeciated, file data) and AE (model speciated). Re- +C named RDEMIS_AE to GET_AERO_EMIS. +C 11 Apr 08 J.Kelly: added code to emit coarse surface area +C 4 Jan 10 J.Young: restructure; eliminate ref to older AERO versions +C 21 Feb 10 J.Young: move sea salt emissions to its own module (SSEMIS) +C 23 Apr 10 J.Young: replace include files with mechanism namelists +C 30 Apr 10 J.Young: update to use aero_reeng by Steve Howard, Prakash Bhave, +C Jeff Young, and Sergey Napelenok +C 23 Jul 10 D.Wong: remove CLOSE3 and BARRIER +C 24 Feb 11 J.Young: Reorganized module with initialization and timestepping +C procedures +C 25 Mar 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C 04 Apr 11 S.Howard: Added mode dimension to SS_MAP array +C 11 May 11 D.Wong: incorporated twoway model implementation +C 18 Aug 11 David Wong: In the merge inline point source PM species calculation, +C arrays EMBUFF and PMEMIS_PT have incorrect index values + +C----------------------------------------------------------------------- + + USE AERO_DATA, ONLY: N_MODE + + IMPLICIT NONE + +C aerosol emissions: [ppmv/s] for mass & number spcs, [m2/mol/s] for surface area spcs + REAL, ALLOCATABLE, SAVE :: VDEMIS_AE( :,:,:,: ) + + INTEGER :: PM_EMLYRS ! number of vertical layers on emis file (set in EMIS_DEFN) + + PUBLIC VDEMIS_AE, PM_EMLYRS, AERO_EMIS_INIT, GET_AERO_EMIS + PRIVATE + +C Variables for converting mass emissions rate to number emissions rate + REAL, SAVE :: FACNUM( N_MODE ) + +C Variables for converting mass emissions rate to 2nd moment emissions rate + REAL, SAVE :: FACSRF( N_MODE ) + +C Variables for the thickness and volume of each grid cell + REAL, ALLOCATABLE, SAVE :: CELLHGT( : ) ! grid-cell height [sigma] + REAL, ALLOCATABLE, SAVE :: CELLVOL( : ) ! grid-cell volume [m2*sigma] + +C Emission rate of all aerosol species interpolated to current time + REAL, ALLOCATABLE, SAVE :: EMBUFF ( :,:,:,: ) ! in all grid cells + REAL, ALLOCATABLE, SAVE :: PM_EM ( : ) ! in one grid cell + REAL, ALLOCATABLE, SAVE :: EM_RATE ( : ) ! + REAL, ALLOCATABLE, SAVE :: EM_PART ( :,: ) ! + INTEGER, ALLOCATABLE, SAVE :: EM_MAP ( :,: ) ! index in namelist table + REAL, ALLOCATABLE, SAVE :: EM_FAC ( :,: ) ! Namelist emissions scaling factor + INTEGER, ALLOCATABLE, SAVE :: NUM_MAP ( : ) ! + REAL, ALLOCATABLE, SAVE :: NUM_FAC ( : ) ! + INTEGER, ALLOCATABLE, SAVE :: SRF_MAP ( : ) ! + REAL, ALLOCATABLE, SAVE :: SRF_FAC ( : ) ! + INTEGER, ALLOCATABLE, SAVE :: SS_MAP ( :,: ) ! + +C EMBUFF mass emission rate input global array +C PM_EM mass emission rate input localized to one grid cell +C EM_RATE scaled PM_EM +C EM_PART particulate mass emission rate in one grid cell +C EM_MAP mass emission rate index in VDEMIS_AE (CGRID) +C EM_FAC mass emission Namelist scaling factor for VDEMIS_AE (CGRID) +C NUM_MAP number emission rate index in VDEMIS_AE (CGRID) +C NUM_FAC +C SRF_MAP sfc area emission rate index in VDEMIS_AE (CGRID) +C SRF_FAC +C SS_MAP sea salt emission rate index in SSOUTM + +C Factor for converting aerosol emissions from input units ... + REAL, ALLOCATABLE, SAVE :: CONVEM_PM( : ) ! into [ug/m2/sec] + +C Variables for converting emission rates into molar-mixing-ratio units + REAL, PARAMETER :: GPKG = 1.0E+03 ! g/kg + REAL, PARAMETER :: MGPG = 1.0E+06 ! ug/g + +C Domain decomposition info from emission and meteorology files + INTEGER, SAVE :: STARTCOL, ENDCOL, STARTROW, ENDROW + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + +C For handling vapor-phase sulfuric acid emissions + INTEGER, SAVE :: VSULF ! index to H2SO4 in VDEMIS array + INTEGER, SAVE :: VPSO4 ! index to PSO4 in EM_RATE array + +C Miscellaneous variables + INTEGER :: IDX + CHARACTER( 96 ) :: XMSG = ' ' + INTEGER, SAVE :: LOGDEV + INTEGER, EXTERNAL :: SETUP_LOGDEV + + CONTAINS + +C----------------------------------------------------------------------- + FUNCTION AERO_EMIS_INIT ( JDATE, JTIME, TSTEP, NEMIS_AE ) RESULT ( SUCCESS) + +C Revision History: + +C 30 Aug 01 J.Young: dynamic allocation - Use INTERPX +C 29 Jul 03 P.Bhave: added compatibility with emission files that contain +C PM10, PEC, POA, PNO3, PSO4, and PMF, but do not +C contain PMC +C 20 Aug 03 J.Young: return aero emissions in molar mixing ratio, ppm units +C 09 Oct 03 J.Gipson: added MW array for AE emis species to module contents +C 01 Sep 04 P.Bhave: changed MW for primary organics from 120 to 220 g/mol, +C to match MWPOA in subroutine ORGAER3. +C 31 Jan 05 J.Young: dyn alloc - removed HGRD_ID, VGRID_ID, and COORD_ID +C include files because those parameters are now +C inherited from the GRID_CONF module +C 26 Apr 05 P.Bhave: removed code supporting the "old type" of emission +C files that had unspeciated PM10 and PM2.5 only +C removed need for 'AERO_CONST.EXT' by declaring the +C required variables locally +C simplified the CONVM, CONVN, CONVS calculations +C updated and enhanced in-line documentation +C 03 May 05 P.Bhave: fixed bug in the H2SO4 unit conversion, initially +C identified by Jinyou Liang of CARB +C 13 Jun 05 P.Bhave: calculate sea-salt emissions; execute if MECHNAME = AE4 +C read input fields from new OCEAN_1 file +C read extra input fields from MET_CRO_2D and MET_CRO_3D +C write diagnostic sea-salt emission file +C added TSTEP to call vector for diagnostic output file +C inherit MWs from AE_SPC.EXT instead of hardcoding +C find pointers to CGRID indices instead of hardcoding +C 08 Mar 07 P.Bhave& added capability for emission files that contain +C S.Roselle: POC or POA +C 30 Jan 08 P.Bhave: added compatibility with AE5 mechanisms +C 23 Mar 08 J.Young: modifications to allow for in-line point source emissions +C 11 Apr 08 J.Kelly: added code to emit coarse surface area +C 09 Sep 08 P.Bhave: backward compatibility with AE4 mechanisms +C 20 Feb 10 J.Young: move ssemis out to its own F90 module +C 25 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C 04 Apr 11 S.Howard: Reorganized SS_MAP as a 2-D array + +C References: +C CRC76, "CRC Handbook of Chemistry and Physics (76th Ed)", +C CRC Press, 1995 +C Hobbs, P.V. "Basic Physical Chemistry for the Atmospheric Sciences", +C Cambridge Univ. Press, 206 pp, 1995. +C Snyder, J.P. "Map Projections-A Working Manual", U.S. Geological Survey +C Paper 1395 U.S.GPO, Washington, DC, 1987. +C Binkowski & Roselle Models-3 Community Multiscale Air Quality (CMAQ) +C model aerosol component 1: Model Description. +C J. Geophys. Res., Vol 108, No D6, 4183 +C doi:10.1029/2001JD001409, 2003 +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain configuration + USE CGRID_SPCS ! CGRID mechanism species + USE SSEMIS ! sea-salt emissions + USE AERO_DATA + USE PRECURSOR_DATA + USE UTILIO_DEFN + + INCLUDE SUBST_RXCMMN ! to get mech name + INCLUDE SUBST_CONST ! physical and mathematical constants + 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 ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + INTEGER, INTENT( IN ) :: NEMIS_AE ! number of aerosol emissions species + LOGICAL SUCCESS + +C Local Variables: + +C Geometric mean diameter by volume (or mass) of emitted particles in +C each mode [ m ]. See paragraph #14 of Binkowski & Roselle (2003) + REAL, PARAMETER :: DGVEM( N_MODE ) = (/ 0.03E-6, 0.3E-6, 6.0E-6 /) + +C Geometric standard deviation of emitted particles in each mode, as +C described in paragraph #14 of Binkowski & Roselle (2003) + REAL, PARAMETER :: SGEM( N_MODE ) = (/ 1.7, 2.0, 2.2 /) + +C Variables for calculating the volume of each grid cell + REAL DX1, DX2 ! grid-cell width and length [m] + REAL CELLAREA ! grid-cell area [m2] + +C Factor for converting aerosol emissions from input units ... + REAL CONVEM_PM_MASS ! into [ug/sec] + +C Domain decomposition info from emission and meteorology files + INTEGER GXOFF, GYOFF ! origin offset + +C Miscellaneous variables + INTEGER STATUS ! ENV..., ALLOCATE status + CHARACTER( 16 ), SAVE :: PNAME = 'AERO_EMIS_INIT' + CHARACTER( 16 ) :: VNAME ! temp var for species names + INTEGER L, N, S ! Loop indices + +C ---------------------------------------------------------------------- + + LOGDEV = SETUP_LOGDEV() + +C *** Map data modules + CALL MAP_AERO() + CALL MAP_PRECURSOR() + CALL MAP_PMEMIS() + +C *** set up for sea-salt emission processing + IF ( .NOT. SSEMIS_INIT( JDATE, JTIME, TSTEP ) ) THEN + XMSG = 'Failure initializing sea-salt emission processing' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + END IF + + IF ( NEMIS_AE .GT. 0 ) THEN ! all EMLAYS + ALLOCATE ( VDEMIS_AE( NEMIS_AE,PM_EMLYRS,MY_NCOLS,MY_NROWS ), + & STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = 'VDEMIS_AE memory allocation failed' + CALL M3WARN ( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + VDEMIS_AE = 0.0 ! array assignment + END IF + +C *** Calculate factors for converting 3rd moment emission rates into number +C emission rates. See Equation 7b of Binkowski & Roselle (2003) + DO N = 1, N_MODE + FACNUM( N ) = EXP( 4.5 * LOG( SGEM( N ) ) ** 2 ) / DGVEM( N ) ** 3 + END DO + +C *** Calculate factors for converting 3rd moment emission rates into 2nd +C moment emission rates. See Equation 7c of Binkowski & Roselle (2003) + DO N = 1, N_MODE +! FACTM2( N ) = EXP( 0.5 * LOG( SGEM( N ) ) ** 2 ) / DGVEM( N ) + FACSRF( N ) = PI * EXP( 0.5 * LOG( SGEM( N ) ) ** 2 ) / DGVEM( N ) + END DO + +C *** Find location of sulfuric acid vapor in VDEMIS array + VNAME = 'SULF' + IDX = INDEX1 ( VNAME, N_GC_EMIS, GC_EMIS ) + IF ( IDX .NE. 0 ) THEN + VSULF = IDX ! index for vapor-phase H2SO4 emissions + ELSE + XMSG = 'Could not find ' // VNAME // 'in gas table' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + +C *** Allocate memory for PM_EM, EMBUFF, CELLHGT, CELLVOL, and CONVEM_PM + ALLOCATE ( PM_EM( N_EMIS_PM ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** PM_EM memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( EMBUFF( NCOLS,NROWS,PM_EMLYRS,N_EMIS_PM ), + & STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** EMBUFF memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( CONVEM_PM( PM_EMLYRS ), + & CELLHGT( PM_EMLYRS ), + & CELLVOL( PM_EMLYRS ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** CONVEM_PM, CELLHGT or CELLVOL memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Allocate memory for EM_RATE, EM_PART, EM_MAP, EM_FAC, NUM_MAP, NUM_FAC, SRF_MAP, SRF_FAC, and SS_MAP + ALLOCATE ( EM_RATE( N_EMIS_PM ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** EM_RATE memory allocation failed' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( EM_PART( N_AEROSPC, N_MODE ), + & EM_MAP ( N_AEROSPC, N_MODE ), + & EM_FAC ( N_AEROSPC, N_MODE ), + & NUM_MAP( N_MODE ), + & NUM_FAC( N_MODE ), + & SRF_MAP( N_MODE ), + & SRF_FAC( N_MODE ), + & SS_MAP ( N_AEROSPC, N_MODE ), STAT = STATUS ) + IF ( STATUS .NE. 0 ) THEN + XMSG = '*** memory allocation failed for ' + & // 'EM_PART, EM_MAP, EM_FAC, NUM_MAP, NUM_FAC, SRF_MAP, SRF_FAC, or SS_MAP' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Map indices of emission species + EM_MAP = 0 ! array assignment + EM_FAC = 1.0 ! array assignment ! array assignment + DO S = 1, N_AEROSPC + IF ( AEROSPC( S )%EMIS .NE. ' ' ) THEN + ! Verify that aerospc( S )%emis is a pm emis + DO N = 1, N_MODE + IF ( AEROSPC( S )%NAME( N ) .NE. ' ' ) THEN + EM_MAP( S,N ) = INDEX1( AEROSPC( S )%NAME( N ), N_AE_EMIS, AE_EMIS ) + EM_FAC( S,N ) = AE_EMIS_FAC( EM_MAP( S,N ) ) + END IF + END DO + END IF + END DO + +C *** Map aerosol number emission species + NUM_MAP = 0 + NUM_FAC = 1.0 ! array assignment + DO N = 1, N_MODE + NUM_MAP( N ) = INDEX1( AEROMODE( N )%NUM_NAME, N_AE_EMIS, AE_EMIS ) + NUM_FAC( N ) = AE_EMIS_FAC( NUM_MAP( N ) ) +#ifdef verbose1 + write( logdev,* ) 'num_map: ', n, num_map( n ), aeromode( n )%num_name, num_fac( n ) +#endif + IF ( NUM_MAP( N ) .EQ. 0 ) THEN + XMSG = 'Could not find ' // TRIM( AEROMODE( N )%NUM_NAME ) + & // ' in AE_EMIS table' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + END DO + +C *** Map aerosol surface emission species + SRF_MAP = 0 + SRF_FAC = 1.0 ! array assignment + DO N = 1, N_MODE + SRF_MAP( N ) = INDEX1( AEROMODE( N )%SRF_NAME, N_AE_EMIS, AE_EMIS ) + SRF_FAC( N ) = AE_EMIS_FAC( SRF_MAP( N ) ) +#ifdef verbose1 + write( logdev,* ) 'srf_map: ', n, srf_map( n ), aeromode( n )%srf_name, srf_fac( n ) +#endif + IF ( SRF_MAP( N ) .EQ. 0 ) THEN + XMSG = 'Could not find ' // TRIM( AEROMODE( N )%SRF_NAME ) + & // ' in AE_EMIS table' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + END DO + +C *** Map sea salt emission species + SS_MAP = 0 ! array assignment + DO S = 1, NSSSPC + IDX = SSSPC_MAP( S ) +#ifdef verbose1 + write( logdev,* ) 'ssspc_map: ', s, idx, ssspc_map( s ) +#endif + DO N = 2, N_MODE ! add SEASALT indices to EM_MAP + IF ( AEROSPC( IDX )%NAME( N ) .NE. ' ' ) THEN + EM_MAP( IDX,N ) = INDEX1( AEROSPC( IDX )%NAME( N ), N_AE_EMIS, AE_EMIS ) + SS_MAP( IDX,N ) = S +#ifdef verbose1 + write( logdev,* ) 'ss_map: ', s, n, idx, ss_map( idx,n ), aerospc( idx )%name( n ) +#endif + END IF + END DO + END DO + +#ifdef verbose1 + do s = 1, n_aerospc + do n = 1, n_mode + if ( em_map( s,n ) .ne. 0 ) then + write( logdev,* ) 'em_map: ', n, s, em_map( s,n ), aerospc( s )%name( n ), em_fac( s,n ) + end if + end do + end do +#endif + +C *** find index of SO4 emissions + VPSO4 = 0 + DO S = 1, N_EMIS_PM +! IF ( PMEM_MAP( S ) .EQ. ASO4_IDX ) VPSO4 = S + IF ( PMEM_MAP( S ) .EQ. ASO4_IDX ) THEN + VPSO4 = S +#ifdef verbose1 + write( logdev,* ) 'vpso4: ', s, pmem_map( s ), aso4_idx, vpso4 +#endif + END IF + END DO + + IF ( VPSO4 .EQ. 0 ) THEN + XMSG = 'Cannot define index for SO4 emissions: ' + & // 'aerospc%emis='' '' in AERO_DATA.F' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + +C *** Get length and width of each grid cell +C note: crude estimate is made for LAT/LONG coordinate systems + IF ( GDTYP_GD .EQ. LATGRD3 ) THEN + DX1 = DG2M * XCELL_GD ! in m + DX2 = DG2M * YCELL_GD + & * COS( PI180*( YORIG_GD + YCELL_GD + & * FLOAT( GL_NROWS/2 ) ) ) ! in m + ELSE + DX1 = XCELL_GD ! in m + DX2 = YCELL_GD ! in m + END IF + +C *** Get height of grid cell in each layer in sigma coordinates +C Multiply by grid area [m2] to obtain grid volume + CELLAREA = DX1 * DX2 + DO L = 1, PM_EMLYRS + CELLHGT( L ) = X3FACE_GD( L ) - X3FACE_GD( L-1 ) + CELLVOL( L ) = CELLHGT( L ) * CELLAREA + END DO + +C *** Get scaling factor for converting aerosol emissions from +C their input units to [ug/s] and then to [ug/m2/s] using layer- +C specific grid-cell volume. Calling DESC3( EMIS_1 ) assumes EMIS_1 +C already opened. + + IF ( PMEM_UNITS .EQ. 'G/S' .OR. + & PMEM_UNITS .EQ. 'g/s' ) THEN + CONVEM_PM_MASS = MGPG ! (g/s) -> (ug/s) + ELSE IF ( PMEM_UNITS .EQ. 'KG/HR' .OR. + & PMEM_UNITS .EQ. 'kg/hr' ) THEN + CONVEM_PM_MASS = GPKG * MGPG / 3600.0 ! (kg/hr) -> (ug/s) + ELSE + XMSG = 'Units incorrect on ' // EMIS_1 + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + END IF + + DO L = 1, PM_EMLYRS + CONVEM_PM( L ) = CONVEM_PM_MASS / CELLVOL( L ) + END DO + +C *** Get domain window info from input files + + CALL SUBHFILE ( EMIS_1, GXOFF, GYOFF, + & STARTCOL, ENDCOL, STARTROW, ENDROW ) + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + SUCCESS = .TRUE.; RETURN + + END FUNCTION AERO_EMIS_INIT + +C----------------------------------------------------------------------- + + SUBROUTINE GET_AERO_EMIS ( JDATE, JTIME, TSTEP, RJACM, VDEMIS ) + +C GET_AERO_EMIS reads PM emissions from gridded input file and +C optionally from plume rise calculated point source emissions (via VDEMIS +C array) and converts into molar-mixing-ratio units, for use in the vertical +C diffusion routines + +C Key Subroutines/Functions Called: SSEMIS_INIT, GET_SSEMIS, DUST_INIT, GET_DUST_EMIS + +C Revision History: + +C 18 Aug 11 David Wong: In the merge inline point source PM species calculation, +C arrays EMBUFF and PMEMIS_PT have incorrect index values + +C ---------------------------------------------------------------------- + USE GRID_CONF ! horizontal & vertical domain specifications + USE CGRID_SPCS ! CGRID mechanism species + USE PT3D_DEFN, ONLY: PT3DEMIS, PMEMIS_PT ! from plume rise + USE PTMAP, ONLY: N_SPC_PTPM, PTPM_MAP ! defines emissions file(s) PM mapping + USE AERO_DATA + USE PRECURSOR_DATA + USE SSEMIS ! sea-salt emissions + USE UTILIO_DEFN + + INCLUDE SUBST_CONST ! physical and mathematical constants + 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( 3 ) ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + ! TSTEP(2) = sciproc sync. step (chem) + ! TSTEP(3) = twoway model time step w.r.t. wrf time + ! step and wrf/cmaq call frequency + REAL, INTENT( IN ) :: RJACM( NCOLS,NROWS,NLAYS ) ! recip of mid-layer + ! Jacobian [1/m] + REAL, INTENT( INOUT ) :: VDEMIS( :,:,:,: ) ! gas emissions [ppmv/s] + +C Geometric Constants + REAL, PARAMETER :: F6DPI = 6.0 / PI + REAL, PARAMETER :: F6DPIM9 = 1.0E-9 * F6DPI ! 1.0E-9 = Kg/ug + +C flag when PMC is calc'd from PM10 +! Logical, Parameter :: PMCfromPM10 = .false. + +C Local variables for sea salt emission rates (grid cell value) + REAL :: CR_SSM( N_AEROSPC,N_MODE ) ! mass + REAL :: CR_SSN( N_MODE ) ! number + REAL :: CR_SSS( N_MODE ) ! surface area + + REAL( 8 ) :: GSFAC ! into [ug/m3/sec] + +C Variables interpolated from the meteorological input files + REAL DENS( NCOLS,NROWS,NLAYS ) ! air density [kg/m3] + +C Variables for converting emission rates into molar-mixing-ratio units + REAL, PARAMETER :: RAVO = 1.0 / AVO ! reciprocal of Avogadro + REAL( 8 ) :: CONVM ! conversion factor for mass emissions [m3/mol] + REAL( 8 ) :: CONVN ! conversion factor for number emissions [1e6*m3] + REAL( 8 ) :: CONVS ! conversion factor for surface area emissions [m3/mol] + +C Third moment emissions rates [m3/m3/s] + REAL( 8 ) :: EMISM3( N_MODE ) + +C Number emissions rates [1/m3/s] + REAL( 8 ) :: EM_NUM( N_MODE ) + +C Surface area emission rates [m2/m3/s] + REAL( 8 ) :: EM_SRF( N_MODE ) + +C Miscellaneous variables + CHARACTER( 16 ), SAVE :: PNAME = 'GET_AERO_EMIS' + INTEGER C, R, L, N, V, S ! Loop indices +! REAL( 8 ) :: FINETOT +#ifdef Verbose2 + real sumem +#endif + +C ---------------------------------------------------------------------- + +C *** Read aerosol emission rates from file and interpolate to the current +C time. Store result in EMBUFF array. + + IF ( PT3DEMIS ) THEN ! in-line plume rise + + EMBUFF = 0.0 ! array assignment + + DO S = 1, N_EMIS_PM ! read 2d file + IDX = PMEM_MAP( S ) + IF ( .NOT. INTERPX( EMIS_1, AEROSPC( IDX )%EMIS, PNAME, + & STARTCOL,ENDCOL, STARTROW,ENDROW, 1,1, + & JDATE, JTIME, EMBUFF( 1,1,1,S ) ) ) THEN + XMSG = 'Could not read ' + & // TRIM( AEROSPC( IDX )%EMIS ) // ' from ' // EMIS_1 + CALL M3WARN ( PNAME, JDATE, JTIME, XMSG ) + END IF + END DO + + DO S = 1, N_SPC_PTPM ! merge inline point src PM species + V = PTPM_MAP( S ) ! set in PT3D_DEFN + DO L = 1, PM_EMLYRS + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS +! EMBUFF( C,R,L,S ) = EMBUFF( C,R,L,S ) + PMEMIS_PT( C,R,L,V ) + EMBUFF( C,R,L,V ) = EMBUFF( C,R,L,V ) + PMEMIS_PT( C,R,L,S ) + END DO + END DO + END DO + END DO + + ELSE ! read 3d file + + DO S = 1, N_EMIS_PM + IDX = PMEM_MAP( S ) + IF ( .NOT. INTERPX( EMIS_1, AEROSPC( IDX )%EMIS, PNAME, + & STARTCOL,ENDCOL, STARTROW,ENDROW, 1,PM_EMLYRS, + & JDATE, JTIME, EMBUFF( 1,1,1,S ) ) ) THEN + XMSG = 'Could not read ' + & // TRIM( AEROSPC( IDX )%EMIS ) // ' from ' // EMIS_1 + CALL M3WARN ( PNAME, JDATE, JTIME, XMSG ) + END IF + END DO + + END IF + +C *** Read air density [kg/m3], atmospheric pressure [Pa], air temperature +C [K], specific humidity [kg H2O / kg air], and 10m wind speed [m/s] +C from meteorology file. Interpolate to the current time. Store results +C in DENS, PRES, TA, QV, and WSPD10 arrays. + IF ( .NOT. INTERPX( MET_CRO_3D, 'DENS', PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, + & 1,NLAYS, JDATE, JTIME, DENS ) ) THEN + XMSG = 'Could not interpolate DENS from ' // MET_CRO_3D + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Get sea salt emissions + CALL GET_SSEMIS ( JDATE, JTIME, TSTEP, + & CELLVOL( 1 ), RJACM( :,:,1 ), CELLHGT( 1 ) ) + +C *** Loop over each grid cell in layer 1 + + L = 1 + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +C *** Store aerosol emission rates for this grid cell in a 1D array + DO S = 1, N_EMIS_PM + PM_EM( S ) = EMBUFF( C,R,L,S ) + END DO + +C *** Get grid cell values for sea salt emission rates +C Convert units of SSOUTM from [g/m3/s] to [ug/m3/s]. + CR_SSM = 0.0 ! array assignment + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + IF ( SS_MAP( S,N ) .NE. 0 ) + & CR_SSM( S,N ) = SSOUTM( SS_MAP( S,N ),N,C,R ) * MGPG + END DO + CR_SSN( N ) = SSOUTN( N,C,R ) + CR_SSS( N ) = SSOUTS( N,C,R ) + END DO + +C *** Calculate scaling factor for converting mass emissions into [ug/m3/s] +C note: RJACM converts grid heights from sigma coordinates to meters +C Also calculate scaling factors for converting to molar-mixing-ratio units + GSFAC = CONVEM_PM( L ) * RJACM( C,R,L ) + CONVM = MWAIR / GPKG / DENS( C,R,L ) ! [m3/mol] + CONVN = CONVM * RAVO * 1.0E+06 ! 10^6 * [m3] + CONVS = CONVM ! [m3/mol] + +C *** Calculate speciated mass emission rates for fine aerosol [ug/m3/s] + DO S = 1, N_EMIS_PM + EM_RATE( S ) = PM_EM( S ) * GSFAC + END DO + +C *** If PMCfromPM10, the emission file did not contain PMC so +C PM_EM(VPMC) holds PM10 emissions. Substract the PM2.5 species +C from this so PM_EM(VPMC) holds only the coarse emission rate. +! IF ( PMCfromPM10 ) THEN +! FINETOT = 0.0 +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( 2 ) .GT. 0.0 ) +! & FINETOT = FINETOT + EM_RATE( S ) +! END DO +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( N_MODE ) .GT. 0.0 ) +! & EM_RATE( S ) = MAX( 0.0, EM_RATE( S ) - FINETOT ) +! END DO +! END IF + +C *** Extract H2SO4 vapor emission rate from the VDEMIS array, add it to +C the fine-PM sulfate emissions, and remove it from the gas emissions + EM_RATE( VPSO4 ) = EM_RATE( VPSO4 ) + VDEMIS( VSULF,L,C,R ) + & * PRECURSOR_MW( SULF_IDX ) / CONVM + VDEMIS( VSULF,L,C,R ) = 0.0 + +C *** Assign fine-particle emission rates to the fine modes. +C Assume all non-seasalt-emissions of sulfate, nitrate, and unspeciated +C fine PM are in the accumulation mode. Split the carbon emissions +C between the Aitken and accumulation modes, as described in paragraph +C #12 of Binkowski & Roselle (2003). + +C *** Calculate emissions rate for third moments [m3/m3/s] of each mode +C (excluding sea salt), as in Equation 7a of Binkowski & Roselle (2003). + + EM_PART = 0.0 ! array assignment + EMISM3 = 0.0 ! array assignment + DO S = 1, N_EMIS_PM + IDX = PMEM_MAP( S ) + DO N = 1, N_MODE + EM_PART( IDX,N ) = AEROSPC( IDX )%EMIS_SPLIT( N ) + & * EM_RATE( S ) + IF ( .NOT. AEROSPC( IDX )%TRACER ) THEN + EMISM3( N ) = EMISM3( N ) + EM_PART( IDX,N ) + & * ( F6DPIM9 / AEROSPC( IDX )%DENSITY ) + END IF + END DO + END DO + +C *** Calculate the number emissions rate for each mode [1/m3/s], using +C Equation 7b of Binkowski & Roselle (2003). + DO N = 1, N_MODE + EM_NUM( N ) = FACNUM( N ) * EMISM3( N ) + END DO + +C *** Calculate the surface area emissions rate for the fine modes [m2/m3/s], +C using Equation 7c of Binkowski & Roselle (2003). Multiplying by PI +C converts 2nd moment to surface area. + DO N = 1, N_MODE + EM_SRF( N ) = FACSRF( N ) * EMISM3( N ) + END DO + +C *** Units of CR_SSM are ug/m3/s]. Transfer Sea-salt mass emissions +C to mode- and species-specific variables. Sea-salt sulfate in the fine +C modes must be added to the anthropogenic sulfate emissions. Remaining +C sea-salt species are not in the standard inventory. + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + EM_PART( S,N ) = EM_PART( S,N ) + CR_SSM( S,N ) + END DO + END DO + +C *** Add sea salt to the total emissions of particle number and surface area + DO N = 1, N_MODE + EM_NUM( N ) = EM_NUM( N ) + CR_SSN( N ) + EM_SRF( N ) = EM_SRF( N ) + CR_SSS( N ) + END DO + +C *** Convert emission rates into molar-mixing-ratio units, as required by +C the vertical diffusion routines. Mass and number emissions are converted +C to [ppmv/s]. Note: EM_PART has units of [ug/m3/s] and mol(s)/mol(air) is +C 1.0e6 ppmv; so 1.0e-6 ug/g cancels the 1.0e6 ppmv/[mol(s)/mol(air)]. +C Surface area emissions are converted to [m2/mol/s]. +C Save results in the VDEMIS_AE array. + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + IF ( EM_MAP( S,N ) .GT. 0 ) THEN + VDEMIS_AE( EM_MAP( S,N ),L,C,R ) = EM_PART( S,N ) * EM_FAC( S,N ) + & * ( CONVM / AEROSPC_MW( S ) ) + END IF + END DO + VDEMIS_AE( NUM_MAP( N ),L,C,R ) = EM_NUM( N ) * NUM_FAC( N ) * CONVN + VDEMIS_AE( SRF_MAP( N ),L,C,R ) = EM_SRF( N ) * SRF_FAC( N ) * CONVS + END DO + + END DO ! loop on MY_NCOLS + END DO ! loop on MY_NROWS + + DO L = 2, PM_EMLYRS + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +C *** Store aerosol emission rates for this grid cell in a 1D array + DO S = 1, N_EMIS_PM + PM_EM( S ) = EMBUFF( C,R,L,S ) + END DO + +C *** Calculate scaling factor for converting mass emissions into [ug/m3/s] +C note: RJACM converts grid heights from sigma coordinates to meters +C Also calculate scaling factors for converting to molar-mixing-ratio units + GSFAC = CONVEM_PM( L ) * RJACM( C,R,L ) + CONVM = MWAIR / GPKG / DENS( C,R,L ) ! [m3/mol] + CONVN = CONVM * RAVO * 1.0E+06 ! 10^6 * [m3] + CONVS = CONVM ! [m3/mol] + +C *** Calculate speciated mass emission rates for fine aerosol [ug/m3/s] + DO S = 1, N_EMIS_PM + EM_RATE( S ) = PM_EM( S ) * GSFAC + END DO + +C *** If PMCfromPM10, the emission file did not contain PMC so +C PM_EM(VPMC) holds PM10 emissions. Substract the PM2.5 species +C from this so PM_EM(VPMC) holds only the coarse emission rate. +! IF ( PMCfromPM10 ) THEN +! FINETOT = 0.0 +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( 2 ) .GT. 0.0 ) +! & FINETOT = FINETOT + EM_RATE( S ) +! END DO +! DO S = 1, N_EMIS_PM +! IDX = PMEM_MAP( S ) +! IF ( AEROSPC( IDX )%EMIS_SPLIT( N_MODE ) .GT. 0.0 ) +! & EM_RATE( S ) = MAX( 0.0, EM_RATE( S ) - FINETOT ) +! END DO +! END IF + +C *** Extract H2SO4 vapor emission rate from the VDEMIS array, add it to +C the fine-PM sulfate emissions, and remove it from the gas emissions + EM_RATE( VPSO4 ) = EM_RATE( VPSO4 ) + VDEMIS( VSULF,L,C,R ) + & * PRECURSOR_MW( SULF_IDX ) / CONVM + VDEMIS( VSULF,L,C,R ) = 0.0 + +C *** Calculate emissions rate for third moments [m3/m3/s] of each mode +C (excluding sea salt), as in Equation 7a of Binkowski & Roselle (2003). + + EM_PART = 0.0 ! array assignment + EMISM3 = 0.0 ! array assignment + DO S = 1, N_EMIS_PM + IDX = PMEM_MAP( S ) + DO N = 1, N_MODE + EM_PART( IDX,N ) = AEROSPC( IDX )%EMIS_SPLIT( N ) + & * EM_RATE( S ) + IF ( .NOT. AEROSPC( IDX )%TRACER ) THEN + EMISM3( N ) = EMISM3( N ) + EM_PART( IDX,N ) + & * ( F6DPIM9 / AEROSPC( IDX )%DENSITY ) + END IF + END DO + END DO + +C *** Calculate the number emissions rate for each mode [1/m3/s], using +C Equation 7b of Binkowski & Roselle (2003). + DO N = 1, N_MODE + EM_NUM( N ) = FACNUM( N ) * EMISM3( N ) + END DO + +C *** Calculate the surface area emissions rate for the fine modes [m2/m3/s], +C using Equation 7c of Binkowski & Roselle (2003). Multiplying by PI +C converts 2nd moment to surface area. + DO N = 1, N_MODE + EM_SRF( N ) = FACSRF( N ) * EMISM3( N ) + END DO + +C *** Convert emission rates into molar-mixing-ratio units, as required by +C the vertical diffusion routines. Mass and number emissions are +C converted to [ppmv/s]. Surface area emissions are converted to +C [m2/mol/s]. Save results in the VDEMIS_AE array. + + DO N = 1, N_MODE + DO S = 1, N_AEROSPC + IF ( EM_MAP( S,N ) .GT. 0 ) THEN + VDEMIS_AE( EM_MAP( S,N ),L,C,R ) = EM_PART( S,N ) * EM_FAC( S,N ) + & * CONVM / AEROSPC_MW( S ) + END IF + END DO + VDEMIS_AE( NUM_MAP( N ),L,C,R ) = EM_NUM( N ) * NUM_FAC( N ) * CONVN + VDEMIS_AE( SRF_MAP( N ),L,C,R ) = EM_SRF( N ) * SRF_FAC( N ) * CONVS + END DO + + END DO ! loop on MY_NCOLS + END DO ! loop on MY_NROWS + END DO ! loop on PM_EMLYRS + +#ifdef Verbose2 + write( logdev,'(/"@@@1",i8,i7.6)') jdate, jtime + l = 1 + do s = 1, n_ae_emis + sumem = 0.0 + do r = 1, my_nrows + do c = 1, my_ncols + sumem = sumem + vdemis_ae( s,l,c,r ) + end do + end do + write( logdev,'("@@@1 ",a,g16.6)') ae_emis( s ), sumem + end do +#endif + + RETURN + + END SUBROUTINE GET_AERO_EMIS + + END MODULE AERO_EMIS + diff --git a/models/CCTM/aero/blank/PRECURSOR_DATA.F b/models/CCTM/aero/blank/PRECURSOR_DATA.F new file mode 100755 index 0000000..feaa02a --- /dev/null +++ b/models/CCTM/aero/blank/PRECURSOR_DATA.F @@ -0,0 +1,344 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/PRECURSOR_DATA.F,v 1.10 2012/01/19 13:11:38 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module precursor_data + +C Defines gas phase aerosol precursor data. + +C Contains: +C Subroutine extract_precursor +C Subroutine map_precursor +C Subroutine update_precursor +C Function findPrecursor + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C HS 03/10/11 Made OH a required species +C -added OH to "precursor" array (set rxncounter to .FALSE.); +C -added "update" column to precursor array to note which species +C concentrations will be affected by aerosol routines +C -added req_OH and OH_idx variables +C -changed precursor_conc to Real(8) + +C H.Pye 05/22/11: added ALK5RXN to precursor list for SAPRC mechanisms +C 08 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 + +C----------------------------------------------------------------------- + + Implicit None + + Integer, Parameter :: n_precursor = 19 ! # of precursors + + Type precursor_type + Character( 16 ) :: name ! species name + Logical :: rxncounter ! flag to reset counter species + Logical :: update ! update precursor concentration + ! in cgrid after aeroproc + End Type precursor_type + + Type ( precursor_type ), Private :: precursor( n_precursor ) = (/ +C Name RxnCounter Update +C ------- ---------- ------ + & precursor_type( 'NO2 ', .False. , .True. ), + & precursor_type( 'N2O5 ', .False. , .True. ), + & precursor_type( 'HNO3 ', .False. , .True. ), + & precursor_type( 'HONO ', .False. , .True. ), + & precursor_type( 'ISOPRXN', .True. , .True. ), + & precursor_type( 'TRPRXN ', .True. , .True. ), + & precursor_type( 'SULF ', .False. , .True. ), + & precursor_type( 'SULPRD ', .True. , .True. ), + & precursor_type( 'HCL ', .False. , .True. ), + & precursor_type( 'ALK5RXN', .True. , .True. ), + & precursor_type( 'TOLNRXN', .True. , .True. ), + & precursor_type( 'TOLHRXN', .True. , .True. ), + & precursor_type( 'XYLNRXN', .True. , .True. ), + & precursor_type( 'XYLHRXN', .True. , .True. ), + & precursor_type( 'BNZNRXN', .True. , .True. ), + & precursor_type( 'BNZHRXN', .True. , .True. ), + & precursor_type( 'SESQRXN', .True. , .True. ), + & precursor_type( 'NH3 ', .False. , .True. ), + & precursor_type( 'OH ', .False. , .False. ) /) + + +C Required species + Character( 16 ), Private, Parameter :: req_NO2 = 'NO2' + Character( 16 ), Private, Parameter :: req_N2O5 = 'N2O5' + Character( 16 ), Private, Parameter :: req_HNO3 = 'HNO3' + Character( 16 ), Private, Parameter :: req_HONO = 'HONO' + Character( 16 ), Private, Parameter :: req_SULF = 'SULF' + Character( 16 ), Private, Parameter :: req_SULPRD = 'SULPRD' + Character( 16 ), Private, Parameter :: req_HCL = 'HCL' + Character( 16 ), Private, Parameter :: req_NH3 = 'NH3' + Character( 16 ), Private, Parameter :: req_OH = 'OH' + +C Indices of required species + Integer :: NO2_idx + Integer :: N2O5_idx + Integer :: HNO3_idx + Integer :: HONO_idx + Integer :: SULF_idx + Integer :: SULPRD_idx + Integer :: HCL_idx + Integer :: NH3_idx + Integer :: OH_idx + + Real :: precursor_mw( n_precursor ) ! mol wt from cgrid_spcs [g/mol] + + Real( 8 ) :: precursor_conc( n_precursor ) ! precursor concentration [ug/m^3] + + Real :: so4rate ! sulfate gas-phase production rate [ug/m^3*s] + +C Private variables for loading and unloading to CGRID array + Integer :: precursor_map( n_precursor ) ! pointers to CGRID + Logical, Private, Save :: mapped = .False. + + Integer, Private, Save :: logdev + Integer, Private, External :: setup_logdev + + Contains + +C----------------------------------------------------------------------- + Subroutine map_precursor() + +C Defines mapping from CGRID for species concentration and moments. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C HS 03/10/11 Changed vtmp to real(8) +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C---------------------------------------------------------------------- + + Use cgrid_spcs ! CGRID mechanism species + Use utilio_defn + + Implicit None + +C Local Variables: + Character( 80 ) :: xmsg + Real( 8 ) :: vtmp + Integer :: n + Integer :: spc + + logdev = setup_logdev() + + precursor_mw = 0.0 + precursor_map = 0 + +C Build mapping to CGRID for each precursor species + Do spc = 1, n_precursor + n = index1( precursor( spc )%name, n_gc_g2ae, gc_g2ae ) + If ( n .Ne. 0 ) Then + precursor_mw( spc ) = gc_molwt( gc_g2ae_map( n ) ) + precursor_map( spc ) = gc_strt - 1 + gc_g2ae_map( n ) + Else + n = index1( precursor( spc )%name, n_nr_n2ae, nr_n2ae ) + If ( n .Ne. 0 ) Then + precursor_mw( spc ) = nr_molwt( nr_n2ae_map( n ) ) + precursor_map( spc ) = nr_strt - 1 + nr_n2ae_map( n ) + Else + xmsg = 'Species ' // Trim( precursor( spc )%name ) // + & ' in precursor name is not in GC_G2AE or NR_N2AE tables' +! Call m3exit( 'xtract_precursor', 0, 0, xmsg, xstat3 ) + Call m3warn( 'xtract_precursor', 0, 0, xmsg ) + End If + End If + End Do + +C Find indices of required species + NO2_idx = findPrecursor( req_NO2 ) + N2O5_idx = findPrecursor( req_N2O5 ) + HNO3_idx = findPrecursor( req_HNO3 ) + HONO_idx = findPrecursor( req_HONO ) + SULF_idx = findPrecursor( req_SULF ) + SULPRD_idx = findPrecursor( req_SULPRD ) + HCL_idx = findPrecursor( req_HCL ) + NH3_idx = findPrecursor( req_NH3 ) + OH_idx = findPrecursor( req_OH ) + +#ifdef verbose + Write( logdev,'( /5x, a )' ) 'map_precursor required species' + Write( logdev,'( 5x, a, i4 )' ) 'NO2_idx: ', NO2_idx + Write( logdev,'( 5x, a, i4 )' ) 'N2O5_idx: ', N2O5_idx + Write( logdev,'( 5x, a, i4 )' ) 'HNO3_idx: ', HNO3_idx + Write( logdev,'( 5x, a, i4 )' ) 'HONO_idx: ', HONO_idx + Write( logdev,'( 5x, a, i4 )' ) 'SULF_idx: ', SULF_idx + Write( logdev,'( 5x, a, i4 )' ) 'SULPRD_idx: ', SULPRD_idx + Write( logdev,'( 5x, a, i4 )' ) 'HCL_idx: ', HCL_idx + Write( logdev,'( 5x, a, i4 )' ) 'NH3_idx: ', NH3_idx + Write( logdev,'( 5x, a, i4 )' ) 'OH_idx: ', OH_idx +#endif + + mapped = .True. + + Write( logdev,'( 5x, a )' ) ' --- Precursor Species Mapped ---' + + Return + End Subroutine map_precursor + +C----------------------------------------------------------------------- + Subroutine extract_precursor( conc ) + +C Extracts the required precursor data from CGRID into conc. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C SH 03/10/11 Renamed met_data to aeromet_data +C HS 03/10/11 Changed vtmp and gasconv to real(8) +C----------------------------------------------------------------------- + + Use aeromet_data ! air and met variables + Use utilio_defn + + Implicit None + +C Arguments: + Real, Intent( In ) :: conc( : ) + +C Local Variables: + Real( 8 ) :: gasconv ! converts from [ppm] to [ug/m^3] + Real( 8 ) :: vtmp + Integer :: n + Integer :: spc + + If ( .Not. mapped ) Then + Call map_precursor() + End If + +C Compute gas conversion constant + gasconv = Real( airdens * 1.0E3 / mwair, 8 ) + +C Copy grid cell concentrations of precursor species + precursor_conc = 0.0 + + Do spc = 1, n_precursor + n = precursor_map( spc ) + If ( n .Ne. 0 ) Then + vtmp = gasconv * precursor_mw( spc ) + precursor_conc( spc ) = Max( conc( n ) * vtmp, min_gasconc ) + End If + End Do + + Return + End Subroutine extract_precursor + +C------------------------------------------------------------------------ + Subroutine update_precursor( conc ) + +C Updates CGRID aerosol precursor values from the conc array. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. + +C SH 03/10/11 Renamed met_data to aeromet_data +C HS 03/10/11 Only update conc for species with "update" = .TRUE.; +C -changed vtmp and gasconv to real(8) +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use aeromet_data ! air and met variables + Use utilio_defn + + Implicit None + +C arguments: + Real, Intent( Out ) :: conc( : ) + +C local variables: + Character( 80 ) :: xmsg + Real( 8 ) :: gasconv ! converts from [ppm] to [ug/m^3] + Real( 8 ) :: vtmp + Integer :: n + Integer :: spc + + If ( .Not. mapped ) Then + xmsg = 'CGRID Species has not been mapped' + Call m3exit( 'update_precursor', 0, 0, xmsg, xstat3 ) + End If + +C compute gas conversion constant + gasconv = Real( airdens * 1.0E3 / mwair, 8 ) + +C copy precursor_conc back to grid cell concentrations + Do spc = 1, n_precursor + n = precursor_map( spc ) + If ( n .Ne. 0 ) Then + If ( precursor( spc )%update ) Then + If ( precursor( spc )%rxncounter ) Then + conc( n ) = 0.0 + Else + vtmp = precursor_mw( spc ) * gasconv + conc( n ) = Max( precursor_conc( spc ) / vtmp, min_gasconc ) + End If + End If + End If + End Do + + Return + End Subroutine update_precursor + +C----------------------------------------------------------------------- + Function findPrecursor( vname ) Result ( ndx ) + +C Finds the index of 'required' aerosol species in the precursor list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use utilio_defn + + Implicit None + +C Arguments: + Character( 16 ) :: vname + Integer ndx + +C Local Variables: + Integer :: spc + Character( 80 ) :: xmsg + + Do spc = 1, n_precursor + If ( Index( precursor( spc )%name, Trim( vname ) ) .Gt. 0 ) Then + ndx = spc + Return + End If + End Do + + xmsg = 'Required Species ' // Trim( vname ) + & // ' Not found in [precursor names] array' + Call m3exit( 'findPrecursor', 0, 0, xmsg, xstat3 ) + + Return + End Function findPrecursor + + End Module precursor_data diff --git a/models/CCTM/aero/blank/SOA_DEFN.F b/models/CCTM/aero/blank/SOA_DEFN.F new file mode 100755 index 0000000..4ee342e --- /dev/null +++ b/models/CCTM/aero/blank/SOA_DEFN.F @@ -0,0 +1,1637 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/SOA_DEFN.F,v 1.9 2012/01/19 13:10:56 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module soa_defn + +C Defines aerosol species arrays and parameters required in SOA processing. + +C Contains: +C Subroutine extract_soa +C Subroutine update_soa +C Function findVapor +C Function findOrgprod +C Subroutine orgaer + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C HP 03/11/11 Updated monoterpene SOA alphas and Cstars to Carlton et al. 2010 values +C HP 07/24/11 Changed aromatic SOA alphas for consistency with updated reaction counters +C BNZ, TOL, XYL numbers now match Ng et al. 2007 Atmos. Chem. Phys. +C 08 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 +C 13 Aug 13 H. Pye: Xylene and toluene low-NOx yields switched. Values now +C follow experimental data of Ng et al. 2007 ACP as shown in Table 3. +C Values in Table 6 of Ng et al. (previously used) are incorrect. +C 18 Dec 13 G.Sarwar: added orgprod parent names based on RACM2 +C----------------------------------------------------------------------- + Implicit None + + Integer, Parameter :: n_vapor = 12 ! # of partitioning SVOCs + Integer, Parameter :: n_orgprod = 10 ! # of ROG rxn counter species + + Type vapor_type + Character( 16 ) :: name + Real :: alpha ! Mass-based stoichiometric coefficients [ug/m^3]/[ug/m^3] + Real :: cstar ! Effective saturation concentrations [ug/m^3] at 298 K + Real :: enth ! Enthalphy of Vaporization [J/mol] + Character( 16 ) :: soa_name ! Species name + Character( 1 ) :: soa_origin ! A = Anthropogenic; B = Biogenic + Real :: soa_decay ! Factor used in oligomerization + Character( 16 ) :: drog_name ! Precursor name + End Type vapor_type + + Type( vapor_type ), Parameter :: vaporspc( n_vapor ) = (/ +C Name Alpha CStar Enth SOA Decay Drog +C Name Origin Name +C ------- ------- -------- ------- ------ -- ---- ------- + & vapor_type('SV_ALK ', 0.0718, 0.0200, 40.0E3, 'AALKJ ', 'A', 8.0, 'ALK5RXN'), + & vapor_type('SV_XYL1', 0.0310, 1.3140, 32.0E3, 'AXYL1J', 'A', 8.0, 'XYLNRXN'), + & vapor_type('SV_XYL2', 0.0900, 34.4830, 32.0E3, 'AXYL2J', 'A', 8.0, 'XYLNRXN'), + & vapor_type('SV_TOL1', 0.0580, 2.3260, 18.0E3, 'ATOL1J', 'A', 7.0, 'TOLNRXN'), + & vapor_type('SV_TOL2', 0.1130, 21.2770, 18.0E3, 'ATOL2J', 'A', 7.0, 'TOLNRXN'), + & vapor_type('SV_BNZ1', 0.0720, 0.3020, 18.0E3, 'ABNZ1J', 'A', 6.0, 'BNZNRXN'), + & vapor_type('SV_BNZ2', 0.8880, 111.1100, 18.0E3, 'ABNZ2J', 'A', 6.0, 'BNZNRXN'), + & vapor_type('SV_TRP1', 0.1393, 14.7920, 40.0E3, 'ATRP1J', 'B', 10.0, 'TRPRXN '), + & vapor_type('SV_TRP2', 0.4542, 133.7297, 40.0E3, 'ATRP2J', 'B', 10.0, 'TRPRXN '), + & vapor_type('SV_ISO1', 0.2320, 116.0100, 40.0E3, 'AISO1J', 'B', 5.0, 'ISOPRXN'), + & vapor_type('SV_ISO2', 0.0288, 0.6170, 40.0E3, 'AISO2J', 'B', 5.0, 'ISOPRXN'), + & vapor_type('SV_SQT ', 1.5370, 24.9840, 40.0E3, 'ASQTJ ', 'B', 15.0, 'SESQRXN')/) + +C Required species + Character( 16 ), Private, Parameter :: req_sviso1 = 'SV_ISO1' + Character( 16 ), Private, Parameter :: req_sviso2 = 'SV_ISO2' + Character( 16 ), Private, Parameter :: req_aeiso1 = 'AISO1' + Character( 16 ), Private, Parameter :: req_aeiso2 = 'AISO2' + Character( 16 ), Private, Parameter :: req_aeiso3 = 'AISO3' + Character( 16 ), Private, Parameter :: req_aeolga = 'AOLGA' + Character( 16 ), Private, Parameter :: req_aeolgb = 'AOLGB' + Character( 16 ), Private, Parameter :: req_aeorgc = 'AORGC' + +C Indices of required species + Integer :: iso1_idx + Integer :: iso2_idx + Integer :: aiso1_idx + Integer :: aiso2_idx + Integer :: aiso3_idx + Integer :: aolga_idx + Integer :: aolgb_idx + Integer :: aorgc_idx + + Real :: vapor_mw ( n_vapor ) ! Molecular weights + Real :: vapor_conc( n_vapor ) ! vapor concentration + Integer :: drog_map ( n_vapor ) ! drog mapping assignments + +C orgprod species + + Type orgprod_type + Character( 16 ) :: name + Character( 16 ) :: parent + Character( 16 ) :: aerospc ! Non-volatile species name + Real :: alphaH ! Stoichiometric coefficients for non-volatile aromatic SOA [ug/m^3]/[ug/m^3] + End Type orgprod_type + +C This default orgprod table is for CB05, parent names are changed in subroutine +C extract_soa for the SAPRC99 and SAPRC07T mechanisms +C + Type( orgprod_type ), Save :: orgprod( n_orgprod ) = (/ +C Name Parent Aerospc AlphaH +C ------- ------- ------ ------ + & orgprod_type( 'ALK5RXN', 'ALK5RXN', ' ', 0.000 ), + & orgprod_type( 'XYLNRXN', 'XYL ', ' ', 0.000 ), + & orgprod_type( 'XYLHRXN', 'XYL ', 'AXYL3J', 0.360 ), + & orgprod_type( 'TOLNRXN', 'TOL ', ' ', 0.000 ), + & orgprod_type( 'TOLHRXN', 'TOL ', 'ATOL3J', 0.300 ), + & orgprod_type( 'BNZNRXN', 'BENZENE', ' ', 0.000 ), + & orgprod_type( 'BNZHRXN', 'BENZENE', 'ABNZ3J', 0.370 ), + & orgprod_type( 'TRPRXN ', 'TRPRXN ', ' ', 0.000 ), + & orgprod_type( 'ISOPRXN', 'ISOPRXN', ' ', 0.000 ), + & orgprod_type( 'SESQRXN', 'SESQRXN', ' ', 0.000 ) /) + + + Real :: orgprod_mw ( n_orgprod ) ! Mol weight of reactive organic gases + Real :: orgprod_conc ( n_orgprod ) ! orgprod concentration + Integer :: orgprod_aeroMap( n_orgprod ) ! orgprod pointers to aerospc + Integer :: soa_aeroMap ( n_vapor ) ! soa pointers to aerospc + +C mapping variables used for loading and unloading to CGRID array + Integer :: vapor_map( n_vapor ) ! pointers of vapor species to CGRID + Integer :: orgprod_map( n_orgprod ) ! pointers of orgprod species to CGRID + Logical, Private, Save :: mapped = .False. + + Character( 16 ), Private, Save :: pname = 'Soa_Defn ' + + Contains + +C----------------------------------------------------------------------- + Subroutine extract_soa( conc ) + +C Extracts the required soa data from CGRID into the conc array. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use aero_data ! aero species + Use aeromet_data ! air and met variables + Use cgrid_spcs ! CGRID mechanism species + Use utilio_defn + + Implicit None + +C Includes: + INCLUDE SUBST_RXCMMN ! to get mech name + +C Arguments: + Real, Intent( In ) :: conc( : ) + +C Local Variables: + Character( 80 ) :: xmsg + Real :: gasconv + Real :: vtmp + Integer :: n + Integer :: spc + + Real, Save :: alk_factor = 1.00 + + If ( .Not. mapped ) Then + + vapor_mw = 0.0 + vapor_map = 0 + +C Build mapping to CGRID for each vapor species + Do spc = 1, n_vapor + n = index1( vaporspc( spc )%name, n_nr_n2ae, nr_n2ae ) + If ( n .Ne. 0 ) Then + vapor_map( spc ) = nr_strt - 1 + nr_n2ae_map( n ) + vapor_mw( spc ) = nr_molwt( nr_n2ae_map( n ) ) + Else + xmsg = 'Species ' // Trim( vaporspc( spc )%name ) + & // ' in vapor name is not in non-reactives table' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End Do + +C define orgprod parent names based on mechanism dependence + If ( INDEX( MECHNAME, 'CB05' ) .EQ. 0 ) then + + If ( INDEX( MECHNAME, 'SAPRC99' ) .GT. 0 ) then + alk_factor = 0.57 ! fraction of ALK5 that can produce SOA + orgprod( 2 )%parent = 'ARO2' + orgprod( 3 )%parent = 'ARO2' + orgprod( 4 )%parent = 'ARO1' + orgprod( 5 )%parent = 'ARO1' + Else If ( INDEX( MECHNAME, 'SAPRC07T' ) .GT. 0 ) then + alk_factor = 0.57 ! fraction of ALK5 that can produce SOA + orgprod( 2 )%parent = 'MXYL' + orgprod( 3 )%parent = 'MXYL' + orgprod( 4 )%parent = 'TOLUENE' + orgprod( 5 )%parent = 'TOLUENE' + Else If( INDEX(MECHNAME, 'RACM2') .GT. 0) then + alk_factor = 0.57 ! fraction of ALK5 that can produce SOA + orgprod( 2 )%parent = 'XYM' + orgprod( 3 )%parent = 'XYM' + orgprod( 4 )%parent = 'TOL' + orgprod( 5 )%parent = 'TOL' + Else + xmsg = 'Mechanism ' // MECHNAME + & // ' is not supported in this version of the model' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + + End If ! non CB05 condition + + +C Build mapping to CGRID for each ORGPROD species and find MW of parent + + orgprod_map = 0 + Do spc = 1, n_orgprod + n = index1( orgprod( spc )%name, n_gc_g2ae, gc_g2ae ) + If ( n .Ne. 0 ) Then + orgprod_map( spc ) = gc_strt - 1 + gc_g2ae_map( n ) + n = index1( orgprod( spc )%parent, n_gc_spc, gc_spc ) + If ( n .Ne. 0 ) Then + orgprod_mw( spc ) = gc_molwt( n ) + Else + xmsg = 'Species ' // orgprod( spc )%parent + & // ' in ORGPROD parent name is not in gas species table' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End If + End Do + +C Find indices of required species + iso1_idx = findVapor( req_sviso1 ) + iso2_idx = findVapor( req_sviso2 ) + aiso1_idx = findAero( req_aeiso1, .True. ) + aiso2_idx = findAero( req_aeiso2, .True. ) + aiso3_idx = findAero( req_aeiso3, .True. ) + aolga_idx = findAero( req_aeolga, .True. ) + aolgb_idx = findAero( req_aeolgb, .True. ) + aorgc_idx = findAero( req_aeorgc, .True. ) + +C Build mapping array to aero species + soa_aeroMap = 0 + Do spc = 1, n_vapor + If ( vaporspc( spc )%soa_name .Ne. ' ' ) Then + soa_aeroMap( spc ) = findAero( vaporspc( spc )%soa_name, .True. ) + End If + End Do + + orgprod_aeroMap = 0 + Do spc = 1, n_orgprod + If ( orgprod( spc )%aerospc .Ne. ' ' ) Then + orgprod_aeroMap( spc ) = findAero( orgprod( spc )%aerospc, .True. ) + End If + End Do + +C Build mapping array to orgprod species + drog_map = 0 + Do spc = 1, n_vapor + If ( vaporspc( spc )%drog_name .Ne. ' ' ) Then + drog_map( spc ) = findOrgprod( vaporspc( spc )%drog_name ) + End If + End Do + + mapped = .True. + + End If ! mapping condition + +C Compute gas conversion constant + gasconv = airdens * 1.0E3 / mwair + +C Copy grid cell concentrations of vapor species + vapor_conc = 0.0 + + Do spc = 1, n_vapor + n = vapor_map( spc ) + If ( n .Ne. 0 ) Then + vtmp = gasconv * vapor_mw( spc ) + vapor_conc( spc ) = Max( conc( n ) * vtmp, min_gasconc ) + End If + End Do + +C Copy grid cell concentrations of ORGPROD species + orgprod_conc = 0.0 + Do spc = 1, n_orgprod + n = orgprod_map( spc ) + If ( n .Ne. 0 ) Then + orgprod_conc( spc ) = Max( conc( n ), min_gasconc ) + End If + End Do + +C Adjust ALK orgprod for fraction that produces SOA + orgprod_conc( 1 ) = alk_factor * orgprod_conc( 1 ) + + Return + End Subroutine extract_soa + +C----------------------------------------------------------------------- + Subroutine update_soa( conc ) + +C Populates CGRID from the conc array with updated SOA values. + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use aeromet_data ! air and met variables + Use utilio_defn + + Implicit None + +C Arguments: + Real, Intent( Out ) :: conc( : ) + +C Local Variables: + Character( 80 ) :: xmsg + Real :: gasconv + Real :: vtmp + Integer :: n + Integer :: spc + + If ( .Not. mapped ) Then + xmsg = 'CGRID Species has not been mapped' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + +C Compute gas conversion constant + gasconv = airdens * 1.0E3 / mwair + +C Copy vapor_conc back to grid cell concentrations + Do spc = 1, n_vapor + n = vapor_map( spc ) + If ( n .Ne. 0 ) Then + vtmp = vapor_mw( spc ) * gasconv + conc( n ) = Max ( vapor_conc( spc ) / vtmp, min_gasconc ) + ! Write( *,'(a,i5,g16.6)' ) vaporspc( spc )%name, n, conc( n ) + End If + End Do + + Return + End Subroutine update_soa + +C----------------------------------------------------------------------- + Function findVapor( vname ) Result ( ndx ) + +C Finds the index of 'required' semivolatile species in the vaporspc list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use utilio_defn + + Implicit None + +C Arguments: + Character( 16 ) :: vname + Integer ndx + +C Local Variables: + Character( 80 ) :: xmsg + Integer :: spc + + Do spc = 1, n_vapor + If ( Trim( vaporspc( spc )%name ) .Eq. Trim( vname ) ) Then + ndx = spc + Return + End If + End Do + + xmsg = 'Required Species ' // Trim( vname ) // ' not found in [vapor names] array' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + + Return + End Function findVapor + +C----------------------------------------------------------------------- + Function findOrgprod( vname ) result ( ndx ) + +C Finds the index of 'required' organic product species in the orgprod list + +C Revision History: +C First version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + Use utilio_defn ! i/o api + + Implicit None + +C Arguments: + Character( 16 ) :: vname + Integer ndx + +C Local Variables: + Character( 80 ) :: xmsg + Integer :: spc + + Do spc = 1, n_orgprod + ! If ( Index( orgprod( spc )%name, Trim( vname ) ) .Gt. 0 ) Then + If ( Trim( orgprod( spc )%name ) .Eq. Trim( vname ) ) Then + ndx = spc + ! Write( *,'(a,i5)' ) vname, ndx + Return + End If + End Do + + xmsg = 'Required Species ' // Trim( vname ) + & // ' Not found in [orgprod names] array' + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + + Return + End Function findOrgprod + +C----------------------------------------------------------------------- + Subroutine orgaer( dt, layer ) + +C Updates CGRID via several pathways for secondary organic aerosol (SOA) +C formation, as recommended by Edney et al. (2007). These include SOA +C formation from isoprene, monoterpenes, sesquiterpenes, long alkanes, and +C aromatics (incl. benzene). + +C Input includes the concentrations of reactive organic gases (ROG) +C that were oxidized during the time step (ORGPROD), the vapor-phase +C concentration of each semi-volatile organic compound, the +C concentration of each SOA species, and the concentration of primary +C organic aerosol (all concentrations are stored in the CBLK array). +C Output includes updated concentrations of SOA species, vapor-phase +C semi-volatile organic compounds, and moments of the accumulation +C mode. The geometric mean diameter of the accumulation mode is also +C updated. All SOA formation is restricted to the accumulation mode. + +C This code relies on 10 counter species to be incorporated in the +C gas-phase chemical mechanisms to track the amounts of individual +C ROG that reacted during the current time step (i.e., NPREC=10). +C The arrays of length = NPREC are ordered as follows: +C (1) "long" alkanes (ALKRXN) +C (2) low-yield aromatics, high-NOx pathway (XYLNRXN) +C (3) low-yield aromatics, low-NOx pathway (XYLHRXN) +C (4) high-yield aromatics, high-NOx pathway (TOLNRXN) +C (5) high-yield aromatics, low-NOx pathway (TOLHRXN) +C (6) benzene, high-NOx pathway (BNZNRXN) +C (7) benzene, low-NOx pathway (BNZHRXN) +C (8) monoterpenes (TRPRXN) +C (9) isoprene (ISOPRXN) +C (10) sesquiterpenes (SESQRXN) + +C In total, 12 organic species are allowed to partition between the +C vapor and particulate phases (i.e., NCVAP=12). The arrays of +C length = NCVAP are ordered as follows: +C (1) alkane (1 semi-volatile product) +C (2&3) low-yield aromatics, high-NOx pathway (2 products) +C (4&5) high-yield aromatics, high-NOx pathway (2 products) +C (6&7) benzene, high-NOx pathway (2 products) +C (8&9) monoterpenes (2 products) +C (10&11) isoprene (2 products) +C (12) sesquiterpenes (1 product) + +C Equilibrium partitioning calculations are based on the absorptive +C partitioning model of Pankow (1994) that was extended by Odum et +C al. (1996). Saturation vapor pressures (cstar) and mass-based +C stoichiometric yield coefficients (alpha) are obtained from smog- +C chamber studies. Saturation vapor pressures are modified as a +C function of temperature using eqn 6 of Sheehan & Bowman (2001). + +C If the pre-existing organic aerosol concentration is zero, +C gas/particle equilibrium is established only after the organic gas +C concentration reaches the threshold value defined in eqn 9 of +C Schell et al. (2001). Until this threshold value is reached, +C organic vapors do not partition to the particle phase. Once the +C organic gas/particle equilibrium has been established, gas and +C particle-phase concentrations of each condensible species are +C calculated iteratively using a globally convergent variation of +C Newton's method (SUBROUTINE NEWT), as described in eqn 8 of Schell +C et al. (2001). + +C In addition to the various pathways of semi-volatile SOA formation +C treated in previous versions of the model, four types of non- +C volatile SOA are considered here: +C (1) enhancement of isoprene-derived SOA under acidic conditions +C (2) aromatic-derived SOA under low-NOx conditions +C (3) oligomerization of all particle-phase semi-volatile material +C (4) SOA formed by in-cloud oxidation (SUBROUTINE AQCHEM) + +C Previous code revision history: +C Originally coded August 1, 2001 by Dr. Francis S. Binkowski + +C Revised April 4, 2003 by Gerald Gipson to allow for evaporation +C of organics from aerosols. Now total vapor + aerosol phase is +C repartitioned at each time step and totorgsw ( Mo ) does not +C include oldsoa. + +C Revised July 14, 2003 by Dr. Prakash V. Bhave +C - changed cstar(2,3) from 10.103 & 90.925 to 111.11 & 1000.0 +C because smog chamber data of Kalberer et al. were collected +C at 298 K (not 310 K, as was previously assumed) +C - changed mw_vap(9,10) from 184 g/mol to 177 g/mol, to be +C consistent with mwsoa_b +C - modified threshold criteria for establishing gas/particle +C equilibrium by removing the loose criterion involving "mtot" +C - changed variable names to reflect that the combined vapor + +C aerosol concentrations are now being repartitioned during +C each time step (not just the newly formed SVOC's) +C - added documentation and removed extraneous lines of code + +C Revised December 4, 2003 by Dr. Francis S. Binkowski +C - output variables ORGRATE and ORGBRATE removed and replaced +C by SOA_A and SOA_B, the newly equilibrated values of +C Anthropogenic and Biogenic SOA, respectively. These are non- +C negative values. +C - variable jj also removed + +C Revised January 8, 2004 by Dr. Prakash V. Bhave +C - removed the output variable YIELD. It has no physical meaning +C after the 12/04/2003 revisions. + +C Revised January 12, 2004 by Dr. Chris G. Nolte +C - for computational efficiency, modified the initial caer guess +C used as input to NEWT. If NEWT returns check .eq. true, then +C NEWT is called again with a guess of caer = 0.5*ctot +C - removed ITS parameter from NEWT call vector +C - fixed bug where concentrations less than TOLMIN (i.e., 1.0E-12) +C were reset to 1.0e-30 +C - removed extraneous code related to "Pandis method" of SVOC +C partitioning when threshold criterion is not met (i.e., +C insufficient organic matter to establish gas/particle +C equilibrium) ** results unaffected by this change +C +C Revised September 7, 2007 by Dr. Sergey L. Napelenok +C - Replaced old SOA species (SOA_A, SOA_B) with an array of +C precursor-specific SOA species. Replaced OLDSOA_A and OLDSOA_B +C with an array (OLDSOA). Updated call vector accordingly. +C - Deleted nole* and nbio* variables (now obsolete) +C - Increased the dimension of several arrays to accommodate new +C SOA precursors (benzene, sesquiterpenes) and pathways (low-NOx, +C acid-catalyzed, oligomers, in-cloud) +C +C Revised November 29, 2007 by Dr. Prakash V. Bhave +C - Renamed subroutine from ORGAER3 to ORGAER5 +C - Modified M2 and M3 calculations to account for the updated +C definition of DRY aerosol (which now includes non-volatile SOA) +C - Updated Hvap and corresponding cstar values +C - Added parameters for SOA from isoprene and sesquiterpenes +C - Updated aromatic SOA scheme to include semi-volatile and non- +C volatile products that form under high-NOx and low-NOx +C conditions, respectively +C - Added oligomerization process +C - Added enhancement of isoprene SOA under acidic conditions +C +C Revised June 2, 2008 by Dr. Prakash V. Bhave +C - Changed h_vap of benzene SOA to match that of toluene SOA, based +C on consultation with Dr. Ed Edney and Dr. Tad Kleindienst. + +C Revised June 5, 2008 by Drs. Prakash Bhave and Sergey Napelenok +C - Simplified the code for conserving low-volatility isoprene +C oxidation products and removed a minor bug in the acid-induced +C isoprene SOA calculation. +C +C Revised September 9, 2008 by Dr. Prakash V. Bhave +C - Increased alpha values for SV_TRP1, SV_TRP2, and SV_SQT by a +C factor of 1.3 to correct for the implicit assumption of unit +C density in those SOA yield parameters. +C - Reduced SOA/SOC ratio of AISO1 and AISO2 from 2.5 to 1.6, and +C increased SOA/SOC ratio of AISO3 from 2.5 to 2.7. Accordingly, +C the molar masses of AISO1 and AISO2 were decreased to 96 g/mol +C and the molar mass of AISO3 was increased to 162. + +C References: +C 1. Edney, E.O., T.E. Kleindienst, M. Lewandowski, and J.H. +C Offenberg, Updated SOA chemical mechanism for the Community +C Multi-Scale Air Quality model, EPA 600/X-07/025, U.S. EPA, +C Research Triangle Park, NC, 2007. + +C 2. Pankow, J. F., An absorption model of gas/particle partitioning +C of organic compounds in the atmosphere, Atmos. Environ., Vol 28, +C No 2, 185-188, 1994. + +C 3. Odum, J. R., T. Hoffmann, F. Bowman, D. Collins, R. C. Flagan, +C and J. H. Seinfeld, Gas/particle partitioning and secondary +C organic aerosol yields, Environ. Sci. Technol., Vol 30, No 8, +C 2580-2585, 1996. + +C 4. Sheehan, P. E. and F. M. Bowman, Estimated effects of temperature +C on secondary organic aerosol concentrations, Environ. Sci. +C Technol., Vol 35, No 11, 2129-2135, 2001. + +C 5. Schell, B., I. J. Ackermann, H. Hass, F. S. Binkowski, and +C A. Abel, Modeling the formation of secondary organic aerosol +C within a comprehensive air quality modeling system, J. Geophys. +C Res., Vol 106, No D22, 28275-28293, 2001. + +C 6. Strader, R., F. Lurmann, and S. N. Pandis, Evaluation of +C secondary organic aerosol formation in winter, Atmos. Environ., +C Vol 33, 4849-4863, 1999. + +C 7. Ng, N. L., J. H. Kroll, A. W. H. Chan, P. S. Chhabra, R. C. +C Flagan, and J. H. Seinfeld, Secondary organic aerosol formation +C from m-xylene, toluene, and benzene, Atmos. Chem. Phys., Vol 7, +C 3909-3922, 2007a. + +C 8. Griffin, R. J., D. R. Cocker III, R. C. Flagan, and J. H. +C Seinfeld, Organic aerosol formation from the oxidation of +C biogenic hydrocarbons, J. Geophys. Res., Vol 104, No D3, +C 3555-3567, 1999. + +C 9. Bian, F. and F. M. Bowman, Theoretical method for lumping +C multicomponent secondary organic aerosol mixtures, Environ. +C Sci. Technol., Vol 36, No 11, 2491-2497, 2002. + +C 10. Offenberg, J. H., T. E. Kleindienst, M. Jaoui, M. Lewandowski, +C and E. O. Edney, Thermal properties of secondary organic +C aerosols, Geophys. Res. Lett., Vol 33, L03816, doi:10.1029/ +C 2005GL024623, 2006. + +C 11. Bahreini, R., M. D. Keywood, N. L. Ng, V. Varutbangkul, S. Gao, +C R. C. Flagan, J. H. Seinfeld, D. R. Worsnop, and J. L. Jimenez, +C Measurements of secondary organic aerosol from oxidation of +C cycloalkenes, terpenes, and m-xylene using an Aerodyne aerosol +C mass spectrometer, Environ. Sci. Technol., Vol 39, 5674-5688, +C 2005. + +C 12. Alfarra, M. R., D. Paulsen, M. Gysel, A. A. Gaforth, J. Dommen, +C A. S. H. Prevot, D. R. Worsnop, U. Baltensperger, and H. Coe, +C A mass spectrometric study of secondary organic aerosols formed +C from the photooxidation of anthropogenic and biogenic precursors +C in a reaction chamber, Atmos. Chem. Phys., Vol 6, 5279-5293, +C 2006. + +C 13. Ng, N. L., P. S. Chhabra, A. W. H. Chan, J. D. Surratt, J. H. +C Kroll, A. J. Kwan, D. C. McCabe, P. O. Wennberg, A. Sorooshian, +C S. M. Murphy, N. F. Dalleska, R. C. Flagan, and J. H. Seinfeld, +C Effect of NOx level on secondary organic aerosol (SOA) formation +C from the photooxidation of terpenes, Atmos. Chem. Phys., Vol 7, +C 5159-5174, 2007b. + +C 14. Kostenidou, E., R. K. Pathak, and S. N. Pandis, An algorithm for +C the calculation of secondary organic aerosol density combining +C AMS and SMPS data, Aerosol Sci. Technol., Vol 41, 1002-1010, +C 2007. + +C 15. Offenberg, J. H., C. W. Lewis, M. Lewandowski, M. Jaoui, T. E. +C Kleindienst, and E. O. Edney, Contributions of toluene and +C alpha-pinene to SOA formed in an irradiated toluene/alpha-pinene/ +C NOx/air mixture: comparison of results using 14C content and SOA +C organic tracer methods, Environ. Sci. Technol., Vol 41, 3972- +C 3976, 2007. + +C 16. Henze, D. K. and J. H. Seinfeld, Global secondary organic aerosol +C from isoprene oxidation, Geophys. Res. Lett., Vol 33, L09812, +C doi:10.1029/2006GL025976, 2006. + +C 17. Kleindienst, T. E., M. Jaoui, M. Lewandowski, J. H. Offenberg, +C C. W. Lewis, P. V. Bhave, and E. O. Edney, Estimates of the +C contributions of biogenic and anthropogenic hydrocarbons to +C secondary organic aerosol at a southeastern US location, Atmos. +C Environ., Vol 41, 8288-8300, 2007. + +C 18. Kalberer, M., D. Paulsen, M. Sax, M. Steinbacher, J. Dommen, +C A. S. H. Prevot, R. Fisseha, E. Weingartner, V. Frankevich, +C R. Zenobi, and U. Baltensperger, Identification of polymers as +C major components of atmospheric organic aerosols, Science, Vol +C 303, 1659-1662, 2004. + +C 19. Turpin, B. J. and H.-J. Lim, Species contributions to PM2.5 mass +C concentrations: revisiting common assumptions for estimating +C organic mass, Aero. Sci. Technol., Vol 35, 602-610, 2001. + +C 20. Surratt, J. D., M. Lewandowski, J. H. Offenberg, M. Jaoui, T. E. +C Kleindienst, E. O. Edney, and J. H. Seinfeld, Effect of acidity +C on secondary organic aerosol formation from isoprene, Environ. +C Sci. Technol., Vol 41, 5363-5369, 2007. + +C Revision History: +C First orgaer version was coded in April 2010 by Steve Howard with +C Prakash Bhave, Jeff Young, and Sergey Napelenok. +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + +C Key Subroutines/Functions called: newt + + Use aero_data + Use aeromet_data + Use utilio_defn + + Implicit None + +C Arguments: + Real :: dt ! Synchronization time step [ s ] + Integer :: layer ! model layer number + +C External functions: + Integer, External :: setup_logdev + +C Local variables: + Logical, Save :: first_time = .True. + Integer, Save :: logdev + Character( 80 ) :: xmsg + Integer :: i + + Real, Save :: mwpoa ! Molecular weight of POA [ g/mol ] + + Real, Save :: mw_vap_m1( n_vapor ) ! Inverse MW of SVOCs [ mol/g ] + + Real, Save :: drog_ppm2ug( n_orgprod ) ! [ ppm per ug/m3 ] for ORGPROD at + ! reference temperature and pressure + +C Parameters & variables for adjusting cstar to ambient conditions + Real, Parameter :: tref = 298.0 ! reference temperature [ K ] + Real, Parameter :: trefm1 = 1.0 / tref ! inverse of reference temperature + Real, Parameter :: prefm1 = 1.0 / stdatmpa ! inverse of reference pressure + Real, Parameter :: rgas1 = 1.0 / rgasuniv ! reciprocal of universal gas constant + Real, Parameter :: kolig = 0.69314718 / 72000.0 ! 20h half-life of oligomerization rate [ 1/s ] + Real, Parameter :: olgrat = 2.1 ! SOA/SOC ratio for oligomers + Real, Parameter :: kacid = 0.00361 ! acid-induced enhancement factor + Real, Parameter :: orgfac = 1.0E-9 * f6dpi / 2.0E3 + Real, Parameter :: convfac_298 = 101325.0 * rgas1 * trefm1 ! P/RT at 1 atm and 298 K [ mole/m**3 ] + + Real convfac + Real tt1, tt2 ! temperature-related factors + Real tempcorr ! temperature correction factor for cstar + +C Variables used in oligomerization calculations + Real expdt ! non-dimensional loss coefficient + Real nsvpa ! particle-phase anthropogenic SVOC [ umolC/m3 ] + Real nsvpb ! particle-phase biogenic SVOC [ umolC/m3 ] + +C Variables used in acid-enhanced isoprene SOA calculations + Real hplus ! accumulation-mode H+ conc [ nmol/m3 ] + Real aiso12 ! particle-phase isoprene SVOC [ ug/m3 ] + Real vviso ! vapor-phase isoprene SVOC [ ug/m3 ] + Real xiso3 ! newly produced AISO3J [ ug/m3 ] + Real isofrac ! ratio for depletion of vapor-phase products + +C Variables used in equilibrium partitioning calculations + Real drog( n_orgprod ) ! change in precursor conc [ ug/m3 ] + Real totrog( n_vapor ) ! drog conc mapped to each SVOC [ ug/m3 ] + Real c0 ( n_vapor ) ! cstar at AIRTEMP [ ug/m3 ] + Real ctoti ( n_vapor ) ! SVOC conc before current time step [ ug/m3 ] + Real prod ( n_vapor ) ! SVOC generated during current step [ ug/m3 ] + Real ctotf ( n_vapor ) ! SVOC conc after current time step [ ug/m3 ] + Real caer ( n_vapor ) ! SVOC conc in aerosol phase [ ug/m3 ] + Real totorgsw ! POA + non-volatile SOA [ umole/m3 ] + Real totorg ! SOA + POA before time step [ umole/m3 ] + Real threshold ! criterion for establishing gas/part equil. + Real, Parameter :: threshmin = 1.0E-19 ! small positive number + Real, Parameter :: ctolmin = 1.0E-06 + Logical check ! flag to indicate if NEWT subroutine + ! converged to a spurious root + +C Variables for updating 2nd and 3rd moments + Real old_m3 ! initial 3rd moment minus nonvol SOA [ mom/m3 ] + Real old_m2 ! initial 2nd moment minus nonvol SOA [ mom/m3 ] + Real new_m3 ! final 3rd moment with updated SOA [ mom/m3 ] + Real new_m2 ! final 2nd moment with updated SOA [ mom/m3 ] + +C----------------------------------------------------------------------- + + If ( first_time ) Then + first_time = .False. + logdev = setup_logdev() + +C Set unit conversion and inverse mw constants + + Do i = 1, n_orgprod + drog_ppm2ug( i ) = orgprod_mw( i ) * convfac_298 + End Do + + Do i = 1, n_vapor + mw_vap_m1( i ) = 1.0 / vapor_mw( i ) + End Do + + mwpoa = aerospc_mw( apoc_idx ) + + End If ! first_time + +C Compute 3rd moment, 2nd moment, and Dg without nonvolatile SOA. Cloud-produced +C SOA (i.e., orgcj) is not subtracted here because it is unchanged in this subroutine + old_m3 = moment3_conc( 2 ) + Do i = 1, n_aerospc + If ( aerospc( i )%nonVol_soa .And. i .Ne. aorgc_idx ) Then + old_m3 = old_m3 - orgfac * aerospc_conc( i,2 ) + End If + End Do + + old_m2 = moment2_conc( 2 ) * ( old_m3 / moment3_conc( 2 ) ) ** ( 2.0 / 3.0 ) + aeromode_diam( 2 ) = aeromode_diam( 2 ) * Sqrt( old_m2 / moment2_conc( 2 ) ) + +C Set temperature factors + tt1 = tref / airtemp + tt2 = trefm1 - 1.0 / airtemp + convfac = tt1 * airpres * prefm1 + +C Initialize drog from ORGPROD and change units to [ ug / m**3 ] + Do i = 1, n_orgprod + drog( i ) = orgprod_conc( i ) * drog_ppm2ug( i ) * convfac + end Do + +C Assignment of drog to totrog + Do i = 1, n_vapor + totrog( i ) = drog( drog_map( i ) ) + End Do + +C Transfer non-volatile products directly to aerospc_conc array (2nd mode) + Do i = 1, n_orgprod + If ( orgprod_aeroMap( i ) .Gt. 0 ) Then + aerospc_conc( orgprod_aeroMap( i ),2 ) = + & aerospc_conc( orgprod_aeroMap( i ),2 ) + & + orgprod( i )%alphaH * drog( i ) + End If + End Do + +C Oligomerization + +C Convert semi-volatile SOA to non-volatile oligomers by an exponential decay +C process that conserves carbon mass. + + nsvpa = 0.0 + nsvpb = 0.0 + + Do i = 1, n_vapor + If ( vaporspc( i )%soa_origin .Eq. 'A' ) + & nsvpa = nsvpa + aerospc_conc( soa_aeroMap( i ),2 ) + & * mw_vap_m1( i ) * vaporspc( i )%soa_decay + If ( vaporspc( i )%soa_origin .Eq. 'B' ) + & nsvpb = nsvpb + aerospc_conc( soa_aeroMap( i ),2 ) + & * mw_vap_m1( i ) * vaporspc( i )%soa_decay + End Do + + expdt = exp( - kolig * dt ) + + Do i = 1, n_vapor + aerospc_conc( soa_aeroMap( i ),2 ) = + & aerospc_conc( soa_aeroMap( i ),2 ) * expdt + End Do + + aerospc_conc( aolga_idx,2 ) = aerospc_conc( aolga_idx,2 ) + & + 12.0 * nsvpa * ( 1.0 - expdt ) * olgrat + aerospc_conc( aolgb_idx,2 ) = aerospc_conc( aolgb_idx,2 ) + & + 12.0 * nsvpb * ( 1.0 - expdt ) * olgrat + +C Compute molar concentrations of non-volatile organic material and total +C organic material; in future code updates, molecular weights of non-volatile +C SOA species should be inherited from the include files or namelists to avoid +C hard-coded values. + + totorgsw = ( aerospc_conc( apoc_idx,1 ) + aerospc_conc( apoc_idx,2 ) ) / mwpoa + Do i = 1, n_aerospc + If ( aerospc( i )%nonVol_soa ) Then + totorgsw = totorgsw + aerospc_conc( i,2 ) / aerospc_mw( i ) + End If + End Do + + totorg = totorgsw + Do i = 1, n_vapor + totorg = totorg + aerospc_conc( soa_aeroMap( i ),2 ) * mw_vap_m1( i ) + End Do + +C Initialize ctoti as sum of vapor-phase and particle-phase SVOCs +C Note: all of these CBLK species are in [ug/m**3] + Do i = 1, n_vapor + ctoti( i ) = vapor_conc( i ) + aerospc_conc( soa_aeroMap( i ),2 ) + End Do + +C Equilibrium Partitioning Calculations + +C Initial guess of caer is computed as follows: +C From eqn (8) of Schell et al. (2001) +C caer = ctotf - c0 * (caer/MW) / totorg +C Assuming totorg doesn't change during the timestep, +C caer * (1 + c0/MW / totorg) = ctotf +C caer = ctotf / ( 1 + c0/MW / totorg ) + + threshold = 0.0 + Do i = 1, n_vapor + tempcorr = tt1 * Exp( vaporspc( i )%enth * rgas1 * tt2 ) + c0( i ) = vaporspc( i )%cstar * tempcorr + prod( i ) = vaporspc( i )%alpha * totrog( i ) + ctotf( i ) = ctoti( i ) + prod( i ) + threshold = threshold + ctotf( i ) / c0( i ) + caer( i ) = ctotf( i ) * totorg ! initial + & / (totorg + c0( i ) * mw_vap_m1( i ) ) ! guess + End Do + +C Check If gas/particle equilibrium can be established + If ( ( threshold .Gt. 1.0 ) .Or. ( totorgsw .Gt. threshmin ) ) Then + +C Calculate new SOA by partitioning. This method uses a globally convergent +C Newton-Raphson method coded by Dr Benedikt Schell to solve the nonlinear +C quadratic system shown in eqn 8 of Schell et al: +C A(i) * caer(i) ** 2 + B * caer(i) + C(i) = 0.0, +C where B(i) contains the sum of all caer(j), for j not equal to i. + + Call newt( layer, caer, n_vapor, check, + & ctotf, c0, mw_vap_m1, totorgsw ) + If ( check ) Then +C Try again with initial guess of 50/50 gas/aerosol split. + Do i = 1, n_vapor + caer( i ) = 0.5 * ctotf( i ) + End Do + Call newt( layer, caer, n_vapor, check, + & ctotf, c0, mw_vap_m1, totorgsw ) + If ( check ) Then + Write( xmsg,'( A,I4 )' ) ' *** Problem in NEWT at Layer = ', layer + Call m3exit( pname, 0, 0, xmsg, xstat3 ) + End If + End If + +C Constrain caer to values between conmin and ctotf + Do i = 1, n_vapor + + If ( caer( i ) .Lt. conmin ) Then + If ( caer( i ) .Lt. 0.0 ) Then + Write( logdev,* ) 'caer negative at i: ', i, caer( i ), + & ' reset to conmin' + End If + caer( i ) = conmin + End If + + If ( caer( i ) - ctotf( i ) .Gt. ctolmin ) Then + Write( logdev,* ) 'caer-ctotf exceeds ctolmin at i = ', i + Write( logdev,* ) 'caer: ', caer( i ), ' ctotf: ', ctotf( i ) + Write( logdev,* ) 'caer reset to ctotf' + caer( i ) = ctotf( i ) + End If + + End Do + + Else ! threshold not exceeded; no material transferred to aerosol phase + + caer = 0.0 ! array assignment + + End If ! check on equilibrium threshold + +C Transfer particle-phase SOA and vapor-phase SVOCs back to CBLK + Do i = 1, n_vapor + aerospc_conc( soa_aeroMap( i ),2 ) = caer( i ) + vapor_conc( i ) = ctotf( i ) - caer( i ) + End Do + +C Acid-induced Isoprene SOA + +C Particle-phase acidity is parameterized by the air concentration of hydrogen +C ion in the particle phase (hplus). This is computed by electroneutrality, +C and is bounded so that it cannot fall below zero (acid-neutral) nor above the +C range of experimental conditions (530 nmol/m3) tested by Surratt et al. +C (2007). In future code updates, molecular weights of inorganic ions should +C be inherited from include or namelist files to avoid hard-coded values. + + hplus = 0.0 + Do i = 1, n_aerospc + hplus = hplus - 1000.0 * aerospc( i )%charge * aerospc_conc( i,2 ) + & / aerospc_mw( i ) + End Do + hplus = Min( 530.0, Max ( 0.0, hplus ) ) ! restrict extrapolation + +C Compute amount of acid-enhanced isoprene SOA that is produced during the current +C time step (xiso3) using the normalized expression derived from Surratt et al. (2007) + + aiso12 = aerospc_conc( aiso1_idx, 2 ) + aerospc_conc( aiso2_idx, 2 ) + xiso3 = kacid * hplus * aiso12 - aerospc_conc( aiso3_idx,2 ) + +C Update CBLK(VISO3J) while conserving the total concentration of low-volatility +C isoprene-derived products. Since the acid-enhanced product is assumed to be +C non-volatile, only positive values of xiso3 are considered below. Also, xiso3 +C is not allowed to exceed the vapor-phase concentration of isoprene SVOC. We assume +C the xiso3 mass is depleted from the 2 vapor-phase isoprene products in quantities +C proportional to their equilibrium concentrations. The factor of 2.7/1.6 accounts +C for the enhancement in the OM/OC ratio when isoprene SOA is formed in the presence +C of SO2, based on the lab experiments of Kleindienst et al. (2007) + + If ( xiso3 .Gt. 0.0 ) Then + vviso = vapor_conc( iso1_idx ) + vapor_conc( iso2_idx ) + xiso3 = Min( xiso3, vviso ) + aerospc_conc( aiso3_idx,2 ) = aerospc_conc( aiso3_idx,2 ) + xiso3 * ( 2.7 / 1.6 ) + isofrac = vapor_conc( iso1_idx ) / vviso + vapor_conc( iso1_idx ) = vapor_conc( iso1_idx ) - isofrac * xiso3 + vapor_conc( iso2_idx ) = vapor_conc( iso2_idx ) - ( 1.0 - isofrac ) * xiso3 + End If + +C Update 3rd moment, 2nd moment, and Dg in CBLK array by assuming that SOA +C condensation/evaporation does not affect the geometric standard deviation. + + new_m3 = old_m3 + + Do i = 1, n_aerospc + If ( aerospc( i )%nonVol_soa .And. i .Ne. aorgc_idx ) Then + new_m3 = new_m3 + orgfac * aerospc_conc( i,2 ) + End If + End Do + + Do i = 1, n_vapor + new_m3 = new_m3 + orgfac * aerospc_conc( soa_aeroMap( i ),2 ) + End Do + + new_m2 = old_m2 * ( new_m3 / old_m3 ) ** ( 2.0 / 3.0 ) + + moment3_conc( 2 ) = new_m3 + moment2_conc( 2 ) = new_m2 + aeromode_diam( 2 ) = aeromode_diam( 2 ) * Sqrt( new_m2 / old_m2 ) + + Return + End Subroutine orgaer + +C----------------------------------------------------------------------- + SUBROUTINE NEWT( LAYER, X, N, CHECK, + & CTOT, CSAT, IMWCV, MINITW ) + +C Description: +C This subroutine and the underlying subprograms constitute Dr. +C Benedikt Schell's SOA model. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 9.7, 2nd ed. +C +C Given an initial guess X(1:N) for a root in N dimensions, find +C the root by a globally convergent Newton's method. The vector of +C functions to be zeroed, called FVEC(1:N) in the routine below, is +C returned by a user-supplied subroutine that must be called FUNCV +C and have the declaration SUBROUTINE FUNCV(N,X,FVEC). The output +C quantity CHECK is false on a normal return and true if the +C routine has converged to a local minimum of the function FMINV +C defined below. In this case, user should try restarting from a +C different initial guess. +C +C Key Subroutines Called: FDJAC, FMINV, LNSRCH, LUBKSB, LUDCMP +C +C Revision History: +C In CMAQ v4.3 - v4.7.1, this subroutine was embedded in a separate +C Fortran module entitled SOA_NEWT. Below, the Revision History from +C the SOA_NEWT module has been merged with the Revision History from +C this specific subroutine. +C +C CGN 01/12/04 removed ITS from call vector, added documentation, and +C removed extraneous lines of code +C +C SLN 09/18/07 updated NP and NPREC for compatibility with new SOA module +C +C PVB 11/19/07 renamed NP to NCVAP for consistency with ORGAER5 subroutine +C +C SH 02/10/10 embedded the old Fortran module, SOA_NEWT, into a new module, +C SOA_DEFN, so all SOA-related code can be found in one file. Renamed +C NCVAP to n_vapor. Its value is now set in SOA_DEFN (instead of inside +C this subroutine). Added TOLX to the call vector of Subroutine LNSRCH, +C since that parameter is now set in this subroutine (instead of in the +C Fortran module). +C +C References: +C 1. Schell, B., I. J. Ackermann, H. Hass, F. S. Binkowski, and +C A. Abel, Modeling the formation of secondary organic aerosol +C within a comprehensive air quality modeling system, J. Geophys. +C Res., Vol 106, No D22, 28275-28293, 2001. + + IMPLICIT NONE + +C Arguments + + INTEGER LAYER ! model layer + INTEGER N ! dimension of problem + REAL X( N ) ! initial guess of CAER + LOGICAL CHECK + REAL CTOT( N ) ! total concentration GAS + AER + PROD + REAL CSAT( N ) ! saturation conc. of cond. vapor [ug/m^3] + REAL IMWCV( N ) ! inverse molecular weights + REAL MINITW ! weighted initial mass + +C Following Numerical recipes + + Integer NN + REAL FVEC ! vector of functions to be zeroed + COMMON /NEWTV/ FVEC(n_vapor), NN + SAVE /NEWTV/ + +C Parameters + INTEGER, PARAMETER :: MAXITS = 100 ! maximum number of iterations + REAL, PARAMETER :: TOLF = 1.0E-09 ! convergence criterion on fxn values + REAL, PARAMETER :: TOLMIN = 1.0E-12 ! criterion whether spurious conver- + ! gence to a minimum has occurred + REAL, PARAMETER :: TOLX = 1.0E-10 ! convergence criterion on delta_x + REAL, PARAMETER :: STPMX = 100.0 ! scaled maximum step length allowed + +C Local variables + REAL CT + REAL CS + REAL IMW + REAL M + COMMON /NEWTINP/ CT( N_VAPOR ), CS( N_VAPOR ), IMW( N_VAPOR ), M + SAVE /NEWTINP/ + + INTEGER I, ITS, J, INDX( N_VAPOR ) + REAL D, DEN, F, FOLD, STPMAX, SUM, TEMP, TEST + REAL FJAC( N_VAPOR,N_VAPOR ) + REAL G( N_VAPOR), P( N_VAPOR ), XOLD( N_VAPOR ) +! EXTERNAL FDJAC + +C----------------------------------------------------------------------- + + CHECK = .FALSE. + M = MINITW + DO I = 1, N + CT( I ) = CTOT( I ) + CS( I ) = CSAT( I ) + IMW( I ) = IMWCV( I ) + END DO + + NN = N + CALL FMINV( X,F ) ! The vector FVEC is also computed by this call + TEST = 0.0 ! Test for initial guess being a root. Use more + ! stringent test than simply TOLF. + DO I = 1, N + IF ( ABS( FVEC( I ) ) .GT. TEST ) TEST = ABS( FVEC( I )) + END DO + + IF ( TEST .LT. 0.01 * TOLF ) RETURN ! initial guess is a root + SUM = 0.0 ! Calculate STPMAX for line searches + DO I = 1, N + SUM = SUM + X( I ) ** 2 + END DO + STPMAX = STPMX * MAX( SQRT( SUM ), FLOAT( N ) ) + DO ITS = 1, MAXITS ! start of iteration loop + CALL FDJAC( N, X, FJAC ) ! get Jacobian + DO I = 1, N ! compute Delta f for line search + SUM = 0.0 + DO J = 1, N + SUM = SUM + FJAC( J,I ) * FVEC( J ) + END DO + G( I ) = SUM + END DO + DO I = 1, N ! store X + XOLD( I ) = X( I ) + END DO + FOLD = F ! store F + DO I = 1, N ! right-hand side for linear equations + P( I ) = -FVEC( I ) + END DO + CALL LUDCMP( FJAC, N, INDX, D ) ! solve linear equations by LU decomposition + CALL LUBKSB( FJAC, N, INDX, P ) + CALL LNSRCH( CTOT, + & N, XOLD, FOLD, G, ! LNSRCH returns new X and F. It also + & P, X, F, STPMAX, ! calculates FVEC at the new X when it + & TOLX, CHECK ) ! calls FMINV + TEST = 0.0 + DO I = 1, N + IF ( ABS( FVEC( I ) ) .GT. TEST ) TEST = ABS( FVEC( I ) ) + END DO + IF ( TEST .LT. TOLF ) THEN + CHECK = .FALSE. + RETURN + END IF + IF (CHECK) THEN !Check for gradient of F zero, + TEST = 0. !i.e., spurious convergence. + DEN = MAX( F, 0.5 * N ) + DO I = 1, N + TEMP = ABS( G( I ) ) * MAX( ABS( X( I ) ), 1.0 ) / DEN + IF ( TEMP .GT. TEST ) TEST = TEMP + END DO + IF ( TEST .LT. TOLMIN ) THEN + CHECK = .TRUE. + ELSE + CHECK = .FALSE. + END IF + RETURN + END IF + TEST = 0.0 !Test for convergence on delta_x + DO I = 1, N + TEMP = ( ABS( X( I ) - XOLD( I ) ) ) / MAX( ABS( X( I ) ), 1.0 ) + IF ( TEMP .GT. TEST ) TEST = TEMP + END DO + IF ( TEST .LT. TOLX ) RETURN + END DO + WRITE( *,'(a,i2)' ) 'MAXITS exceeded in NEWT ! Layer: ', LAYER + END SUBROUTINE NEWT + +C----------------------------------------------------------------------- + SUBROUTINE FDJAC( N, X, FJAC ) + +C Description: +C Get the Jacobian of the function + +C ( a1 * X1^2 + b1 * X1 + c1 ) +C ( a2 * X2^2 + b2 * X2 + c2 ) +C ( a3 * X3^2 + b3 * X3 + c3 ) +C F(X) = ( a4 * X4^2 + b4 * X4 + c4 ) = 0.0 +C ( ........................ ) +C ( aN * XN^2 + bN * XN + cN ) +C +C a_i = IMW_i +C b_i = SUM(X_j * IMW_j)_j.NE.i + CSAT_i * IMW_i + M +C - CTOT_i * IMW_i +C +C c_i = - CTOT_i * [ SUM(X_j * IMW_j)_j.NE.i + M ] +C +C delta F_i ( 2. * a_i * X_i + b_i If i .EQ. j +C J_ij = ----------- = ( +C delta X_j ( ( X_i - CTOT_i ) * IMW_j If i .NE. j + +C Revision History: +C CGN 01/12/04 changed B1 & B2 to scalars +C SH 02/10/10 renamed NCVAP to n_vapor. Value is inherited from SOA_DEFN. + + IMPLICIT NONE + + INTEGER N ! dimension of problem + REAL X( N ) ! initial guess of CAER + + REAL CT + REAL CS + REAL IMW + REAL M + COMMON /NEWTINP/ CT( N_VAPOR ), CS( N_VAPOR ), IMW( N_VAPOR ), M + + REAL FJAC( N,N ) + + INTEGER I, J ! loop index + REAL A( N_VAPOR ) + REAL B( N_VAPOR ) + REAL B1 + REAL B2 + REAL SUM_JNEI + + DO I = 1, N + A( I ) = IMW( I ) + SUM_JNEI = 0.0 + DO J = 1, N + SUM_JNEI = SUM_JNEI + X( J ) * IMW( J ) + END DO + B1 = SUM_JNEI - ( X( I ) * IMW( I ) ) + B2 = ( CS( I ) - CT( I ) ) * IMW( I ) + M + B( I ) = B1 + B2 + END DO + DO J = 1, N + DO I = 1, N + IF ( I .EQ. J ) THEN + FJAC( I,J ) = 2.0 * A( I ) * X( I ) + B( I ) + ELSE + FJAC( I,J ) = ( X( I ) - CT( I ) ) * IMW( J ) + END IF + END DO + END DO + + RETURN + END SUBROUTINE FDJAC + +C----------------------------------------------------------------------- + SUBROUTINE FMINV( X,F ) + +C Description: +C Returns f = 0.5 * F*F at X. SR FUNCV(N,X,F) is a fixed-name, +C user-supplied routine that returns the vector of functions at X. +C The common block NEWTV communicates the function values back to +C NEWT. + +C Adopted from Numerical Recipes in FORTRAN, Chapter 9.7, 2nd ed. + +C Key Subroutines Called: FUNCV + +C Revision History: +C YOJ 07/31/02 changed FUNCTION FMIN to SUBROUTINE FMINV to avoid errors +C with (some) compilers +C SH 02/10/10 renamed NCVAP to n_vapor. Value is inherited from SOA_DEFN. + + IMPLICIT NONE + + INTEGER N + + REAL X( * ), F + REAL FVEC + + COMMON /NEWTV/ FVEC( N_VAPOR ), N + SAVE /NEWTV/ + + INTEGER I + REAL SUM + CALL FUNCV( N, X, FVEC ) + SUM = 0.0 + DO I = 1, N + SUM = SUM + FVEC( I ) ** 2 + END DO + F = 0.5 * SUM + RETURN + END SUBROUTINE FMINV + +C----------------------------------------------------------------------- + SUBROUTINE FUNCV( N, X, FVEC ) + +C Description: +C From Equation (8) of Schell et al., 2001: +C Caer,i = Ctot,i - Csat,i * (Caer,i/MWi) / +C ( sum_j (Caer,j/MWj) + Cinit/MWinit) +C Let Xi = Caer,i +C a_i = 1 / MWi +C M = Cinit/MWinit +C CTi = Ctot,i +C CSi = Csat,i +C Then, +C Xi = CTi - CSi * (a_i * Xi) / ( sum_j (a_j * Xj) + M ) +C +C Multiply above equation by sum_j(a_j*Xj) + M and group terms +C a_i Xi^2 + ( sum_jnei (a_j*Xj) + M + CSi*a_i - CTi*a_i ) Xi +C - CTi * ( sum_jnei (a_j*Xj) + M ) = 0 +C +C This equation is of the form F(X) = a_i*Xi^2 + b_i*Xi + c_i = 0. +C F(X) is stored as FVEC in this subroutine. +C +C See also FDJAC. + +C Key Subroutines Called: none + +C Revision History: +C CGN 01/12/04 Added documentation, removed extraneous lines of code +C SH 02/10/10 renamed NCVAP to n_vapor. Value is inherited from SOA_DEFN + +C References: +C 1. Schell, B., I. J. Ackermann, H. Hass, F. S. Binkowski, and +C A. Abel, Modeling the formation of secondary organic aerosol +C within a comprehensive air quality modeling system, J. Geophys. +C Res., Vol 106, No D22, 28275-28293, 2001. + + IMPLICIT NONE + + INTEGER N + REAL X( * ) + REAL FVEC( N ) + + REAL CT + REAL CS + REAL IMW + REAL M + COMMON /NEWTINP/ CT( N_VAPOR ), CS( N_VAPOR ), IMW( N_VAPOR ), M + SAVE /NEWTINP/ + + INTEGER I, J + REAL SUM_JNEI + REAL A( N_VAPOR ) + REAL B( N_VAPOR ) + REAL C( N_VAPOR ) + + DO I = 1, N + A( I ) = IMW( I ) + SUM_JNEI = 0.0 + DO J = 1, N + SUM_JNEI = SUM_JNEI + X( J ) * IMW( J ) + END DO + SUM_JNEI = SUM_JNEI - ( X( I ) * IMW( I ) ) + B( I ) = SUM_JNEI + M + ( CS( I ) - CT( I ) ) * IMW( I ) + C( I ) = -CT( I ) * ( SUM_JNEI + M ) + FVEC( I ) = X( I ) * ( A( I ) * X( I ) + B( I ) ) + C( I ) + END DO + + RETURN + END SUBROUTINE FUNCV + +C----------------------------------------------------------------------- + SUBROUTINE LNSRCH( CTOT, + & N, XOLD, FOLD, G, P, + & X, F, STPMAX, TOLX, CHECK) + +C Description: +C Given an n-dimensional point XOLD(1:N), the value of the function +C and gradient there, FOLD and G(1:N), and a direction P(1:N), +C finds a new point X(1:N) along the direction P from XOLD where +C the function FUNC has decreased 'sufficiently'. The new function +C value is returned in F. STPMAX is an input quantity that limits +C the length of the steps so that you do not try to evaluate the +C function in regions where it is undefined or subject to overflow. +C P is usually the Newton direction. The output quantity CHECK is +C false on a normal exit. It is true when X is too close to XOLD. +C In a minimization algorithm, this usually signals convergence and +C can be ignored. However, in a zero-finding algorithm the calling +C program should check whether the convergence is spurious. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 9.7, 2nd ed. + +C Key Subroutines Called: FUNCV + +C Revision History: +C SH 02/10/10 added TOLX to the call vector. In previous versions, this +C parameter was declared in the Module SOA_NEWT (which contained this +C subroutine). + + IMPLICIT NONE + + INTEGER N + REAL TOLX + LOGICAL CHECK + REAL F, FOLD, STPMAX + REAL G( N ), P( N ), X( N ), XOLD( N ) + REAL CTOT( N ) + REAL, PARAMETER :: ALF = 1.E-04 + REAL, PARAMETER :: CONMIN = 1.E-30 + + INTEGER I + REAL A, ALAM, ALAM2, ALAMIN, B, DISC + REAL F2, FOLD2, RHS1, RHS2, SLOPE + REAL SUM, TEMP, TEST, TMPLAM + + CHECK = .FALSE. + SUM = 0.0 + DO I = 1, N + SUM = SUM + P( I ) * P( I ) + END DO + SUM = SQRT( SUM ) + IF ( SUM .GT. STPMAX ) THEN + DO I = 1, N + P( I ) = P( I ) * STPMAX / SUM + END DO + END IF + SLOPE = 0.0 + DO I = 1, N + SLOPE = SLOPE + G( I ) * P( I ) + END DO + TEST = 0.0 + DO I = 1, N + TEMP = ABS( P( I ) ) / MAX( ABS( XOLD( I ) ), 1.0 ) + IF ( TEMP .GT. TEST ) TEST = TEMP + END DO + ALAMIN = TOLX / TEST + ALAM = 1.0 + +101 CONTINUE + +C avoid negative concentrations and set upper limit given by CTOT. + + DO I = 1, N + X( I ) = XOLD( I ) + ALAM * P( I ) + IF ( X( I ) .LE. 0.0 ) X( I ) = CONMIN + IF ( X( I ) .GT. CTOT( I ) ) X( I ) = CTOT( I ) + END DO + CALL FMINV( X,F ) + IF ( ALAM .LT. ALAMIN ) THEN + DO I = 1, N + X( I ) = XOLD( I ) + END DO + CHECK = .TRUE. + RETURN + ELSE IF ( F .LE. FOLD + ALF * ALAM * SLOPE ) THEN + RETURN + ELSE + IF ( ALAM .EQ. 1.0 ) THEN + TMPLAM = -SLOPE / ( 2.0 * ( F - FOLD - SLOPE ) ) + ELSE + RHS1 = F - FOLD - ALAM * SLOPE + RHS2 = F2 - FOLD2 - ALAM2 * SLOPE + A = ( RHS1 / ALAM ** 2 - RHS2 / ALAM2 ** 2 ) / ( ALAM - ALAM2 ) + B = ( -ALAM2 * RHS1 / ALAM ** 2 + ALAM * RHS2 / ALAM2 ** 2 ) + & / ( ALAM - ALAM2 ) + IF ( A .EQ. 0.0 ) THEN + TMPLAM = -SLOPE / ( 2.0 * B ) + ELSE + DISC = B * B - 3.0 * A * SLOPE + TMPLAM = ( -B + SQRT( DISC ) ) / ( 3.0 * A ) + END IF + IF ( TMPLAM .GT. 0.5 * ALAM ) TMPLAM = 0.5 * ALAM + END IF + END IF + ALAM2 = ALAM + F2 = F + FOLD2 = FOLD + ALAM = MAX( TMPLAM, 0.1 * ALAM ) + GO TO 101 + + END SUBROUTINE LNSRCH + +C----------------------------------------------------------------------- + SUBROUTINE LUBKSB( A, N, INDX, B ) + +C Description: +C Solves the set of N linear equations A * X = B. Here A is input, +C not as the matrix A but rather as its LU decomposition, +C determined by the routine LUDCMP. B(1:N) is input as the right- +C hand side vector B, and returns with the solution vector X. A, N, +C and INDX are not modified by this routine and can be left in +C place for successive calls with different right-hand sides B. +C This routine takes into account the possibility that B will begin +C with many zero elements, so it is efficient for use in matrix +C inversion. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 2.3, 2nd ed. +C +C Key Subroutines Called: none +C +C Revision History: +C call vector modified to remove NCVAP and set dimensions to N. + + IMPLICIT NONE + + INTEGER N, INDX( N ) + REAL A( N,N ), B( N ) ! A now has dimension NxN. + + INTEGER I, II, J, LL + REAL SUM + + II = 0 + DO I = 1, N + LL = INDX( I ) + SUM = B( LL ) + B( LL ) = B( I ) + IF ( II .NE. 0 ) THEN + DO J = II, I-1 + SUM = SUM - A( I,J ) * B( J ) + END DO + ELSE IF ( SUM .NE. 0 ) THEN + II = I + END IF + B( I ) = SUM + END DO + DO I = N, 1, -1 + SUM = B( I ) + DO J = I+1, N + SUM = SUM - A( I,J ) * B( J ) + END DO + B( I ) = SUM / A( I,I ) + END DO + + RETURN + END SUBROUTINE LUBKSB + +C----------------------------------------------------------------------- + SUBROUTINE LUDCMP( A, N, INDX, D ) + +C Description: +C Given a matrix A(1:N,1:N), with physical dimension N by N, this +C routine replaces it by the LU decomposition of a rowwise +C permutation of itself. A and N are input. A is output arranged as +C in equation (2.3.14) above; INDX(1:N) is an output vector that +C records vector that records the row permutation effected by the +C partial pivoting; D is output as +-1 depending on whether the +C number of row interchanges was even or odd, respectively. This +C routine is used in combination with SR LUBKSB to solve linear +C equations or invert a matrix. +C +C Adopted from Numerical Recipes in FORTRAN, Chapter 2.3, 2nd ed. + +C Equation (2.3.14) Numerical Recipes, p 36: +C | b_11 b_12 b_13 b_14 | +C | a_21 b_22 b_23 b_24 | +C | a_31 a_32 b_33 b_34 | +C | a_41 a_42 a_43 b_44 | + +C Key Subroutines Called: None + +C Revision History: +C call vector modified to remove NCVAP +C all dimensions now depend upon N only + + IMPLICIT NONE + + INTEGER N, INDX( N ) +! INTEGER NMAX +! PARAMETER ( NMAX = 10 ) ! largest expected N + REAL D, A( N,N ) ! note that A now has dimension NxN + ! NCVAP is ignored + REAL, PARAMETER :: TINY = 1.0E-20 + + INTEGER I, IMAX, J, K + REAL AAMAX, DUM, SUM, VV( N ) + + D = 1 + DO I = 1, N + AAMAX = 0.0 + DO J = 1, N + IF ( ABS(A( I,J ) ) .GT. AAMAX ) AAMAX = ABS( A( I,J ) ) + END DO + IF ( AAMAX .EQ. 0.0 ) THEN + WRITE( *,'(a)' ) '*** Singular matrix in ludcmp!' +! STOP + END IF + VV( I ) = 1.0 / AAMAX + END DO + DO J = 1, N + DO I = 1, J-1 + SUM = A( I,J ) + DO K = 1, I-1 + SUM = SUM - A( I,K ) * A( K,J ) + END DO + A( I,J ) = SUM + END DO + AAMAX = 0.0 + DO I = J, N + SUM = A( I,J ) + DO K = 1, J-1 + SUM = SUM - A( I,K ) * A( K,J ) + END DO + A( I,J ) = SUM + DUM = VV( I ) * ABS( SUM ) + IF ( DUM .GE. AAMAX ) THEN + IMAX = I + AAMAX = DUM + END IF + END DO + IF ( J .NE. IMAX ) THEN + DO K = 1, N + DUM = A( IMAX,K ) + A( IMAX,K ) = A( J,K ) + A( J,K ) = DUM + END DO + D = -D + VV( IMAX ) = VV( J ) + END IF + INDX( J ) = IMAX + IF ( A( J,J ) .EQ. 0.0 ) A( J,J ) = TINY + IF ( J .NE. N ) THEN + DUM = 1.0 / A( J,J ) + DO I = J+1, N + A( I,J ) = A( I,J ) * DUM + END DO + END IF + END DO + + RETURN + END SUBROUTINE LUDCMP + + End Module soa_defn diff --git a/models/CCTM/aero/blank/aero_depv.F b/models/CCTM/aero/blank/aero_depv.F new file mode 100755 index 0000000..54f1430 --- /dev/null +++ b/models/CCTM/aero/blank/aero_depv.F @@ -0,0 +1,1132 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/aero_depv.F,v 1.12 2012/01/19 13:12:14 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C @(#)aero_depv.F 1.3 /project/mod3/CMAQ/src/ae_depv/aero_depv/SCCS/s.aero_depv.F 18 Jun 1997 12:55:48 + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE AERO_DEPV ( CGRID, JDATE, JTIME, TSTEP, MOSAIC, VDEP_AE ) + +C----------------------------------------------------------------------- +C aerosol dry deposition routine +C written 4/9/97 by Dr. Francis S. Binkowski +C uses code from modpar and vdvg from the aerosol module. +C This routine uses a single block to hold information +C for the lowest layer. +C NOTES: This version assumes that RA is available on the met file. +c Array structure for vector optimization +C 26 Apr 97 Jeff - many mods +C 13 Dec 97 Jeff - expect uncoupled CGRID, concs as micro-g/m**3, #/m**3 +C +C 1/11/99 David Wong at LM - change NUMCELLS to CELLNUM in the loop index +C FSB 3/17/99 changed to accommodate surface area/second moment and +C encapsulated the actual drydep calculation into a subroutine which +C is attached to this code +C Jeff - Dec 00 - move CGRID_MAP into f90 module +C FSB 12/11/2000. Logic added to allow deposition of particles at their +C "wet" diameters; that is, accounting for the water on the particles. +C This is done by adjusting the third and second moments for the +C presence of water assuming that the geometric standard deviations +C are not changed by this process. This appears to be a very good +C assumption. +C 30 Aug 01 J.Young: Dyn alloc; Use HGRD_DEFN +C Jan 03 J.Young: Change CGRID dimensions, eliminate re-allocations +C 6 Mar 03 J.Young: eliminate a lot of allocate/deallocates +C 7 Aug 03 S.Roselle: updated code for loading the min aero conc array +C 17 Dec 03 S.Roselle: Adjust 2nd and 3rd moments to include SOA, +C without affecting the geometric standard deviations. +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 07 Jun 05 P.Bhave: Added code to handle new species in the AE4 +C mechanism: ANAI, ANAJ, ANAK, ACLI, ACLJ, ACLK, ASO4K, AH2OK, +C and ANO3K; look for ASEAS only when using AE3 mechanism +C 30 Jan 08 S.Napelenok & P.Bhave: Added code to handle new SOA species +C in AE5; defined DRY aerosol to include nonvolatile SOA spcs +C 14 Apr 08 J.Kelly: Added code to handle new species ANH4K and SRFCOR. +C Also added code to handle variable coarse mode standard deviation +C in AE5 (no longer fixed at 2.2). +C 08 Sep 08 P.Bhave: Backward compatibility with AE4 mechanisms +C standardized names of all coarse-mode variables +C 19 Apr 10 S.Howard: aero re-engineering for modularity +C 23 Apr 10 J.Young: replace chem mechanism include files with namelists +C 10 Mar 11 S.Howard: Renamed met_data to aeromet_data +C 25 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C 20 May 11 D.Schwede: Modified for mosaic +C 31 Aug 11 J.Bash: Moved shared mosaic variables to MOSAIC_MOD +C 27 Sep 11 David Wong: replaced all run time dynamic arrays with allocatable +C arrays to avoid run time memory issue +C 08 Jun 12 J.Young: remove full character blank padding for GNU Fortran (GCC) 4.1.2 +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain specifications + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + USE AERO_DATA ! aero variable data + USE SOA_DEFN ! gas soa data + USE AEROMET_DATA ! Includes CONST.EXT + USE Mosaic_Mod, Only: ADEPVJ, USTARJ, RAJ ! Shared mosaic variables + Use LSM_Mod, Only: N_LUFRAC + Use DEPV_DEFN, Only: ABFLUX + + IMPLICIT NONE + +C Includes: + + INCLUDE SUBST_RXCMMN ! to get mech name + INCLUDE SUBST_FILES_ID ! file name parameters + +C Arguments + REAL, POINTER :: CGRID( :,:,:,: ) + INTEGER, INTENT( IN ) :: JDATE ! current model date , coded YYYYDDD + INTEGER, INTENT( IN ) :: JTIME ! current model time , coded HHMMSS + INTEGER, INTENT( IN ) :: TSTEP ! model time step, coded HHMMSS +! REAL, INTENT( IN ) :: USTARJ( :,:,: ) ! friction velocity [m/s ] for each land use category +! REAL, INTENT( IN ) :: RAJ ( :,:,: ) ! aerodynamic resistance [ s/m ] for each land use category + LOGICAL, INTENT( IN ) :: MOSAIC ! use mosaic option + REAL, INTENT( OUT ) :: VDEP_AE( :,:,: ) ! surrogate deposition velocities [ m s**-1 ] +! REAL, INTENT( OUT ) :: VDEPJ_AE( :,:,:,: ) ! surrogate deposition velocities [ m s**-1 ] for each land use category + +C Parameters + REAL, PARAMETER :: T0 = 288.15 ! [ K ] ! starting standard surface temp. + REAL, PARAMETER :: P0 = 101325.0 ! standard surface pressure [ Pa ] + REAL, PARAMETER :: TWO3 = 2.0 / 3.0 + INTEGER, PARAMETER :: N_AE_DEP_SPC = 9 ! no. of surrogates for aerosol dry dep velocities + +C set up species dimension and indices for deposition velocity internal array VDEP + INTEGER, PARAMETER :: VDNATK = 1, ! Aitken mode number + & VDNACC = 2, ! accumulation mode number + & VDNCOR = 3, ! coarse mode number + & VDMATK = 4, ! Aitken mode mass + & VDMACC = 5, ! accumulation mode mass + & VDMCOR = 6, ! coarse mode mass + & VDSATK = 7, ! Aitken mode surface area + & VDSACC = 8, ! accumulation mode surface area + & VDSCOR = 9 ! coarse mode surface area + +C Local variables: + + CHARACTER( 16 ) :: VDAE_NAME( N_AE_DEP_SPC )! dep vel surrogate name table + DATA VDAE_NAME( 1 ) / 'VNUMATKN' / + DATA VDAE_NAME( 2 ) / 'VNUMACC ' / + DATA VDAE_NAME( 3 ) / 'VNUMCOR ' / + DATA VDAE_NAME( 4 ) / 'VMASSI ' / + DATA VDAE_NAME( 5 ) / 'VMASSJ ' / + DATA VDAE_NAME( 6 ) / 'VMASSC ' / + DATA VDAE_NAME( 7 ) / 'VSRFATKN' / + DATA VDAE_NAME( 8 ) / 'VSRFACC ' / + DATA VDAE_NAME( 9 ) / 'VSRFCOR ' / + + INTEGER, ALLOCATABLE, SAVE :: DEPV_SUR( : ) ! pointer to surrogate + +C Meteorological variables +! REAL PRES ( NCOLS,NROWS ) ! Atmospheric pressure [ Pa ] +! REAL TA ( NCOLS,NROWS ) ! Air temperature [ K ] +! REAL DENS ( NCOLS,NROWS ) ! Air density [ kg/m**3 ] +! REAL RA ( NCOLS,NROWS ) ! aerodynamic resistance [ s/m ] +! REAL USTAR ( NCOLS,NROWS ) ! friction velocity [m/s ] +! REAL WSTAR ( NCOLS,NROWS ) ! convective velocity scale [m/s ] +! REAL HEATFLUX( NCOLS,NROWS ) ! surface heat flux [W/m**2] + + REAL, ALLOCATABLE, SAVE :: PRES ( :,: ) ! Atmospheric pressure [ Pa ] + REAL, ALLOCATABLE, SAVE :: TA ( :,: ) ! Air temperature [ K ] + REAL, ALLOCATABLE, SAVE :: DENS ( :,: ) ! Air density [ kg/m**3 ] + REAL, ALLOCATABLE, SAVE :: RA ( :,: ) ! aerodynamic resistance [ s/m ] + REAL, ALLOCATABLE, SAVE :: USTAR ( :,: ) ! friction velocity [m/s ] + REAL, ALLOCATABLE, SAVE :: WSTAR ( :,: ) ! convective velocity scale [m/s ] + REAL, ALLOCATABLE, SAVE :: HEATFLUX( :,: ) ! surface heat flux [W/m**2] + + CHARACTER( 16 ), SAVE :: AE_VRSN ! Aerosol version name + + INTEGER, SAVE :: NCELLS ! number of cells per layer + + REAL, ALLOCATABLE, SAVE :: XXLSGAT( :,: ) ! log of standard deviation + REAL, ALLOCATABLE, SAVE :: XXLSGAC( :,: ) + REAL, ALLOCATABLE, SAVE :: XXLSGCO( :,: ) + + REAL, ALLOCATABLE, SAVE :: DGATK( :,: ) ! geometric mean diameter + REAL, ALLOCATABLE, SAVE :: DGACC( :,: ) + REAL, ALLOCATABLE, SAVE :: DGCOR( :,: ) + + REAL, ALLOCATABLE, SAVE :: PDENSAT( :,: ) ! particle density + REAL, ALLOCATABLE, SAVE :: PDENSAC( :,: ) + REAL, ALLOCATABLE, SAVE :: PDENSCO( :,: ) + + REAL, ALLOCATABLE, SAVE :: XLM( :,: ) ! mean free path [ m ] + REAL, ALLOCATABLE, SAVE :: AMU( :,: ) ! dynamic viscosity [ kg m**-1 s**-1 ] + + REAL, ALLOCATABLE, SAVE :: VDEP( :,:,: ) ! deposition velocity [ m/s ] + REAL, ALLOCATABLE, SAVE :: VDEPJ( :,:,:,: ) ! deposition velocity [ m/s ] + + REAL M3_WET, M3SUBT, M3_DRY + REAL M2_WET, M2_DRY + + LOGICAL, SAVE :: FIRSTIME = .TRUE. + INTEGER, SAVE :: LOGDEV ! unit number for the log file + CHARACTER( 16 ), SAVE :: PNAME = 'AERO_DEPV' + CHARACTER( 16 ) :: VNAME ! varable name + CHARACTER( 96 ) :: XMSG = ' ' + + INTEGER MDATE, MTIME, MSTEP ! julian date, time and timestep in sec + INTEGER C, R, V, N, J ! loop counters + INTEGER SPC, S ! species loop counter + INTEGER ALLOCSTAT + + INTEGER GXOFF, GYOFF ! global origin offset from file + INTEGER, SAVE :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + + INTERFACE + SUBROUTINE GETDEP_V ( BLKTA, BLKDENS, + & XLM, AMU, + & BLKWSTAR, BLKUSTAR, BLKRA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, + & MOSAIC, BLKUSTARJ, BLKRAJ ) + REAL, INTENT( IN ) :: BLKTA ( :,: ) ! air temperature [ K ] + REAL, INTENT( IN ) :: BLKDENS( :,: ) ! air density [ kg/m**3 ] + REAL, INTENT( IN ) :: XLM( :,: ) ! atmospheric mean free path [ m ] + REAL, INTENT( IN ) :: AMU( :,: ) ! atmospheric dynamic viscosity [ kg/(m s) ] + REAL, INTENT( IN ) :: BLKWSTAR( :,: ) ! convective velocity scale [ m/s ] + REAL, INTENT( IN ) :: BLKUSTAR( :,: ) ! friction velocity [ m/s ] + REAL, INTENT( IN ) :: BLKRA ( :,: ) ! aerodynamic resistance [ s/m ] + REAL, INTENT( IN ) :: DGATK( :,: ) ! nuclei mode geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGACC( :,: ) ! accumulation geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGCOR( :,: ) ! coarse mode geometric mean diameter [ m ] + REAL, INTENT( IN ) :: XXLSGAT( :,: ) ! Aitken mode + REAL, INTENT( IN ) :: XXLSGAC( :,: ) ! accumulation mode + REAL, INTENT( IN ) :: XXLSGCO( :,: ) ! coarse mode + REAL, INTENT( IN ) :: PDENSAT( :,: ) ! average particle density in nuclei mode + REAL, INTENT( IN ) :: PDENSAC( :,: ) ! average particle density in accumulation mode + REAL, INTENT( IN ) :: PDENSCO( :,: ) ! average particle density in coarse mode + REAL, INTENT( OUT ) :: VDEP( :,:,: ) ! deposition velocity [ m/s ] + REAL, INTENT( OUT ) :: VDEPJ( :,:,:,: ) ! deposition velocity [ m/s ] for each land use category + LOGICAL, INTENT( IN ) :: MOSAIC + REAL, OPTIONAL, INTENT( IN ) :: BLKUSTARJ( :,:,: ) ! friction velocity [ m/s ] + REAL, OPTIONAL, INTENT( IN ) :: BLKRAJ ( :,:,: ) ! aerodynamic resistance [ s/m ] + END SUBROUTINE GETDEP_V + END INTERFACE + +C----------------------------------------------------------------------- + + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. + LOGDEV = INIT3() + + NCELLS = NCOLS * NROWS + +C Allocate arrays + ALLOCATE( XXLSGAT( NCOLS,NROWS ), + & XXLSGAC( NCOLS,NROWS ), + & XXLSGCO( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating XXLSGAT, XXLSGAC or XXLSGCO' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( DGATK( NCOLS,NROWS ), + & DGACC( NCOLS,NROWS ), + & DGCOR( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DGATK, DGACC or DGCOR' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( PDENSAT( NCOLS,NROWS ), + & PDENSAC( NCOLS,NROWS ), + & PDENSCO( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating PDENSAT, PDENSAC or PDENSCO' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE( XLM( NCOLS,NROWS ), + & AMU( NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating XLM or AMU' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +! ALLOCATE ( VDEP( NCELLS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + ALLOCATE ( VDEP( NCOLS,NROWS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating VDEP' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + ALLOCATE ( PRES ( NCOLS,NROWS ), + & TA ( NCOLS,NROWS ), + & DENS ( NCOLS,NROWS ), + & RA ( NCOLS,NROWS ), + & USTAR ( NCOLS,NROWS ), + & WSTAR ( NCOLS,NROWS ), + & HEATFLUX( NCOLS,NROWS ), + & STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating arrays' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +! ALLOCATE ( VDEPJ( N_LUFRAC,NCELLS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + ALLOCATE ( VDEPJ( N_LUFRAC,NCOLS,NROWS,N_AE_DEP_SPC ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating VDEPJ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + IF ( MOSAIC ) THEN + ALLOCATE ( ADEPVJ( N_LUFRAC,N_AE_DEPV,NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating ADEV' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END IF + + ALLOCATE ( DEPV_SUR( N_AE_DEPV ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DEPV_SUR' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Open the met files + IF ( .NOT. OPEN3( MET_CRO_3D, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open MET_CRO_3D file ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + IF ( .NOT. OPEN3( MET_CRO_2D, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open MET_CRO_2D file ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + 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 + +C Set the dep vel surrogate pointers + DO V = 1, N_AE_DEPV + N = INDEX1( AE_DEPV( V ), N_AE_DEP_SPC, VDAE_NAME ) + IF ( N .NE. 0 ) THEN + DEPV_SUR( V ) = N + ELSE + XMSG = 'Could not find ' // AE_DEPV( V ) // ' in aerosol' // + & ' surrogate table. >>> Dep vel set to zero <<< ' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + DEPV_SUR( V ) = 0 + END IF + END DO + +C *** get file horizontal grid offsets + CALL SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + END IF ! FIRSTIME + + IF ( N_AE_SPC .LE. 0 ) RETURN + +C begin interpolation of meteorological variables + + MDATE = JDATE + MTIME = JTIME + +C Interpolate time dependent one-layer and layered input variables + +ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc + VNAME = 'RADYNI' + IF ( INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, RA ) ) THEN + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + RA( C,R ) = 1.0 / MAX( RA( C,R ), CONMIN ) + END DO + END DO + ELSE + VNAME = 'RA' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, RA ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + END IF +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + VNAME = 'USTAR' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, USTAR ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'WSTAR' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, WSTAR ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'HFX' + IF ( .NOT. INTERPX( MET_CRO_2D, VNAME, PNAME, + & STRTCOLMC2,ENDCOLMC2, STRTROWMC2,ENDROWMC2, 1,1, + & MDATE, MTIME, HEATFLUX ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_2D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +C Layered variables TA, PRES, DENS: + + VNAME = 'PRES' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,1, + & MDATE, MTIME, PRES ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_3D ' + CALL M3EXIT (PNAME, MDATE, MTIME, XMSG, XSTAT1) + END IF + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,1, + & MDATE, MTIME, TA ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_3D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + VNAME = 'DENS' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,1, + & MDATE, MTIME, DENS ) ) THEN + XMSG = 'Could not interpolate '// VNAME // ' from MET_CRO_3D ' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +C ----------End interpolation of meteorological variables ------------- + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +C Put the grid cell physical data in the block arrays +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +C *** Set meteorological data for the grid cell. + AIRDENS = DENS( C,R ) + AIRTEMP = TA( C,R ) + AIRPRES = PRES( C,R ) + +C *** extract grid cell concentrations of aero species from CGRID +C into aerospc_conc in aero_data module + CALL EXTRACT_AERO( CGRID( C,R,1,: ), .TRUE. ) + +C *** extract soa concentrations from CGRID + CALL EXTRACT_SOA( CGRID( C,R,1,: ) ) + +C *** Calculate aerosol surface area to 2nd moment. + DO S = 1, N_MODE + N = AEROSRF_MAP( S ) + MOMENT2_CONC( S ) = CGRID( C,R,1,N ) / PI + END DO + +C *** Calculate geometric mean diameters and standard deviations of the +C "dry" size distribution + CALL GETPAR( .FALSE., .FALSE. ) + +C add contribution of water and SOA + +C Aitken mode. + M3_DRY = MOMENT3_CONC( 1 ) + M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) + & * AEROSPC_CONC( AH2O_IDX,1 ) + M3_WET = M3_DRY + M3SUBT + M2_DRY = MOMENT2_CONC( 1 ) + M2_WET= M2_DRY * ( M3_WET / M3_DRY ) ** TWO3 + + MOMENT3_CONC( 1 ) = MAX( CONMIN, M3_WET ) + MOMENT2_CONC( 1 ) = MAX( CONMIN, M2_WET ) + +C accumulation mode. + M3_DRY = MOMENT3_CONC( 2 ) + + M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) + & * AEROSPC_CONC( AH2O_IDX,2 ) + DO SPC = 1, N_VAPOR + M3SUBT = M3SUBT + ( 1.0E-9 * F6PI / AEROSPC( APOC_IDX )%DENSITY ) + & * AEROSPC_CONC( SOA_AEROMAP( SPC ),2 ) + END DO + + M3_WET = M3_DRY + M3SUBT + M2_DRY = MOMENT2_CONC(2) + M2_WET = M2_DRY * ( M3_WET / M3_DRY ) ** TWO3 + + MOMENT3_CONC( 2 ) = MAX( CONMIN, M3_WET ) + MOMENT2_CONC( 2 ) = MAX( CONMIN, M2_WET ) + +C coarse mode + M3_DRY = moment3_conc(3) + M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) + & * AEROSPC_CONC( AH2O_IDX,3 ) + M3_WET = M3_DRY + M3SUBT + M2_DRY = MOMENT2_CONC( 3 ) + M2_WET = M2_DRY * ( M3_WET / M3_DRY ) ** TWO3 + + MOMENT3_CONC( 3 ) = MAX( CONMIN, M3_WET ) + MOMENT2_CONC( 3 ) = MAX( CONMIN, M2_WET ) + +C *** Calculate geometric mean diameters and standard deviations of the +C "wet" size distribution + CALL GETPAR( .TRUE., .FALSE. ) + +C Save getpar values to arrays + XXLSGAT( C,R ) = AEROMODE_SDEV( 1 ) + XXLSGAC( C,R ) = AEROMODE_SDEV( 2 ) + XXLSGCO( C,R ) = AEROMODE_SDEV( 3 ) + + DGATK( C,R ) = AEROMODE_DIAM( 1 ) + DGACC( C,R ) = AEROMODE_DIAM( 2 ) + DGCOR( C,R ) = AEROMODE_DIAM( 3 ) + + PDENSAT( C,R ) = AEROMODE_DENS( 1 ) + PDENSAC( C,R ) = AEROMODE_DENS( 2 ) + PDENSCO( C,R ) = AEROMODE_DENS( 3 ) + +C Calculate mean free path [ m ]: + XLM( C,R ) = 6.6328E-8 * P0 * AIRTEMP / ( T0 * AIRPRES ) + +C *** Calcualte dynamic viscosity [ kg m**-1 s**-1 ]: + AMU( C,R ) = 1.458E-6 * AIRTEMP * SQRT( AIRTEMP ) + & / ( AIRTEMP + 110.4 ) + + END DO ! Column LOOP + END DO ! Row LOOP + +C *** get dry deposition velocities: + +! CALL GETDEP_V ( NCELLS, N_AE_DEP_SPC, + IF ( MOSAIC .OR. ABFLUX ) THEN + CALL GETDEP_V ( TA, DENS, + & XLM, AMU, + & WSTAR, USTAR, RA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, + & MOSAIC, USTARJ, RAJ ) + ELSE + CALL GETDEP_V ( TA, DENS, + & XLM, AMU, + & WSTAR, USTAR, RA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, MOSAIC ) + END IF + +C Return dry deposition velocities for aerosols (first layer only). + +! N = 0 + DO R = 1, NROWS + DO C = 1, NCOLS +! N = N + 1 + DO V = 1, N_AE_DEPV + IF ( DEPV_SUR( V ) .GT. 0 ) THEN +! VDEP_AE( V,C,R ) = VDEP( N,DEPV_SUR( V ) ) + VDEP_AE( V,C,R ) = VDEP( C,R,DEPV_SUR( V ) ) + ELSE + VDEP_AE( V,C,R ) = 0.0 + END IF + END DO + END DO + END DO + +! N = 0 + IF ( MOSAIC ) THEN + DO R = 1, NROWS + DO C = 1, NCOLS +! N = N + 1 + DO V = 1, N_AE_DEPV + DO J = 1, N_LUFRAC + IF ( DEPV_SUR( V ) .GT. 0 ) THEN +! ADEPVJ( J,V,C,R ) = VDEPJ( J,N,DEPV_SUR( V ) ) + ADEPVJ( J,V,C,R ) = VDEPJ( J,C,R,DEPV_SUR( V ) ) + ELSE + ADEPVJ( J,V,C,R ) = 0.0 + END IF + END DO + END DO + END DO + END DO + END IF + + RETURN + END SUBROUTINE AERO_DEPV + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +! SUBROUTINE GETDEP_V ( NUMCELLS, N_AE_DEP_SPC, + SUBROUTINE GETDEP_V ( BLKTA, BLKDENS, + & XLM, AMU, + & BLKWSTAR, BLKUSTAR, BLKRA, + & DGATK, DGACC, DGCOR, + & XXLSGAT, XXLSGAC, XXLSGCO, + & PDENSAT, PDENSAC, PDENSCO, + & VDEP, VDEPJ, + & MOSAIC, BLKUSTARJ, BLKRAJ ) + +C *** Calculate deposition velocity for Aitken, accumulation, and +C coarse modes. +C Reference: +C Binkowski F. S., and U. Shankar, The regional particulate +C model 1. Model description and preliminary results. +C J. Geophys. Res., 100, D12, 26191-26209, 1995. + +C May 05 D.Schwede: added impaction term to coarse mode dry deposition +C 25 May 05 J.Pleim: Updated dry dep velocity calculation for aerosols +C to Venkatram and Pleim (1999) +C 20 Jul 05 J.Pleim: Changed impaction term using modal integration of +C Stokes**2 / 400 (Giorgi, 1986, JGR) +C 14 Apr 08 J.Kelly: Added code to calculate deposition velocity of +C coarse surface area and to account for variable +C standard deviation of the coarse mode. +C 08 Sep 08 P.Bhave: Backward compatibility with AE4 mechanisms +C standardized names of all coarse-mode variables +C----------------------------------------------------------------------- + + USE LSM_MOD, Only: n_lufrac ! to get n_lufrac + USE AEROMET_DATA ! Includes CONST.EXT + + IMPLICIT NONE + +C *** input arguments + +C meteorological information in blocked arays: + REAL, INTENT( IN ) :: BLKTA ( :,: ) ! air temperature [ K ] + REAL, INTENT( IN ) :: BLKDENS( :,: ) ! air density [ kg/m**3 ] + +C atmospheric properties + REAL, INTENT( IN ) :: XLM( :,: ) ! atmospheric mean free path [ m ] + REAL, INTENT( IN ) :: AMU( :,: ) ! atmospheric dynamic viscosity [ kg/(m s) ] + +C Planetary boundary laryer (PBL) variables + REAL, INTENT( IN ) :: BLKWSTAR( :,: ) ! convective velocity scale [ m/s ] + REAL, INTENT( IN ) :: BLKUSTAR( :,: ) ! friction velocity [ m/s ] + REAL, INTENT( IN ) :: BLKRA ( :,: ) ! aerodynamic resistance [ s/m ] + +C aerosol properties: + +C modal diameters: [ m ] + REAL, INTENT( IN ) :: DGATK( :,: ) ! nuclei mode geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGACC( :,: ) ! accumulation geometric mean diameter [ m ] + REAL, INTENT( IN ) :: DGCOR( :,: ) ! coarse mode geometric mean diameter [ m ] + +C log of modal geometric standard deviations + REAL, INTENT( IN ) :: XXLSGAT( :,: ) ! Aitken mode + REAL, INTENT( IN ) :: XXLSGAC( :,: ) ! accumulation mode + REAL, INTENT( IN ) :: XXLSGCO( :,: ) ! coarse mode + +C average modal particle densities [ kg/m**3 ] + REAL, INTENT( IN ) :: PDENSAT( :,: ) ! average particle density in nuclei mode + REAL, INTENT( IN ) :: PDENSAC( :,: ) ! average particle density in accumulation mode + REAL, INTENT( IN ) :: PDENSCO( :,: ) ! average particle density in coarse mode + +C Mosaic variables + REAL, OPTIONAL, INTENT( IN ) :: BLKUSTARJ( :,:,: ) ! friction velocity [ m/s ] + REAL, OPTIONAL, INTENT( IN ) :: BLKRAJ ( :,:,: ) ! aerodynamic resistance [ s/m ] + LOGICAL, INTENT( IN ) :: MOSAIC + +C *** output arguments + + REAL, INTENT( OUT ) :: VDEP( :,:,: ) ! deposition velocity [ m/s ] + REAL, INTENT( OUT ) :: VDEPJ( :,:,:,: ) ! deposition velocity [ m/s ] for each land use category + +C *** array indices hardcoded to match SUBROUTINE AERO_DEPV + INTEGER, PARAMETER :: VDNATK = 1, ! Aitken mode number + & VDNACC = 2, ! accumulation mode number + & VDNCOR = 3, ! coarse mode number + & VDMATK = 4, ! Aitken mode mass + & VDMACC = 5, ! accumulation mode mass + & VDMCOR = 6, ! coarse mode mass + & VDSATK = 7, ! Aitken mode surface area + & VDSACC = 8, ! accumulation mode surface area + & VDSCOR = 9 ! coarse mode surface area + +C modal Knudsen numbers + REAL KNATK ! Aitken mode Knudsen number + REAL KNACC ! accumulation " + REAL KNCOR ! coarse mode + +C modal particle diffusivities for number, 2nd, and 3rd moment, or mass: + REAL DCHAT0N, DCHAT0A, DCHAT0C + REAL DCHAT2N, DCHAT2A, DCHAT2C + REAL DCHAT3N, DCHAT3A, DCHAT3C + +C modal sedimentation velocities for number, 2nd, and 3rd moment, or mass: + REAL VGHAT0N, VGHAT0A, VGHAT0C + REAL VGHAT2N, VGHAT2A, VGHAT2C + REAL VGHAT3N, VGHAT3A, VGHAT3C + + INTEGER NCELL, J, C, R + + REAL DCONST1, DCONST1N, DCONST1A, DCONST1C + REAL DCONST2, DCONST3N, DCONST3A, DCONST3C + REAL SC0N, SC0A, SC0C ! Schmidt numbers for number + REAL SC2N, SC2A, SC2C ! Schmidt numbers for 2ND MOMENT + REAL SC3N, SC3A, SC3C ! Schmidt numbers for 3rd moment + REAL STOKEN, STOKEA, STOKEC ! Stokes numbers for each mode + REAL RD0N, RD0A, RD0C ! canopy resistance for number + REAL RD2N, RD2A, RD2C ! canopy resistance for 2nd moment + REAL RD3N, RD3A, RD3C ! canopy resisteance for 3rd moment + REAL UTSCALE ! scratch function of USTAR and WSTAR + REAL NU ! kinematic viscosity [ m**2 s**-1 ] + REAL USTFAC ! scratch function of USTAR, NU, and GRAV + REAL TWOXLM + + REAL, PARAMETER :: BHAT = 1.246 ! Constant from Cunningham slip correction + REAL, PARAMETER :: THREEPI = 3.0 * PI + REAL, PARAMETER :: TWO3 = 2.0 / 3.0 + +C Scalar variables for VARIABLE standard deviations. + + REAL L2SGAT, L2SGAC ! see usage + REAL L2SGCO + + REAL EAT1 ! Aitken mode exp( log^2( sigmag )/8 ) + REAL EAC1 ! accumulation mode exp( log^2( sigmag )/8 ) + REAL ECO1 ! coarse mode exp( log^2( sigmag )/8 ) + + REAL ESAT04 ! Aitken " **4 + REAL ESAC04 ! accumulation " + REAL ESCO04 ! coarse " + + REAL ESAT08 ! Aitken " **8 + REAL ESAC08 ! accumulation " + REAL ESCO08 ! coarse " + + REAL ESAT12 ! Aitken " **12 + REAL ESAC12 ! accumulation " + REAL ESCO12 ! coarse " + + REAL ESAT16 ! Aitken " **16 + REAL ESAC16 ! accumulation " + REAL ESCO16 ! coarse " + + REAL ESAT20 ! Aitken " **20 + REAL ESAC20 ! accumulation " + REAL ESCO20 ! coarse " + + REAL ESAT28 ! Aitken " **28 + REAL ESAC28 ! accumulation " + REAL ESCO28 ! coarse " + + REAL ESAT32 ! Aitken " **32 + REAL ESAC32 ! accumulation " + REAL ESCO32 ! coarse " + + REAL ESAT36 ! Aitken " **36 + REAL ESAC36 ! accumulation " + REAL ESCO36 ! coarse " + + REAL ESAT48 ! Aitken " **48 + REAL ESAC48 ! accumulation " + REAL ESCO48 ! coarse " + + REAL ESAT64 ! Aitken " **64 + REAL ESAC64 ! accumulation " + REAL ESCO64 ! coarse " + + REAL ESAT128 ! Aitken " **128 + REAL ESAC128 ! accumulation " + REAL ESCO128 ! coarse " + + REAL ESAT160 ! Aitken " **160 + REAL ESAC160 ! accumulation " + REAL ESCO160 ! coarse " + + REAL ESATM12 ! Aitken " **(-12) + REAL ESACM12 ! accumulation " + REAL ESCOM12 ! coarse " + + REAL ESATM16 ! Aitken " **(-16) + REAL ESACM16 ! accumulation " + REAL ESCOM16 ! coarse " + + REAL ESATM20 ! Aitken " **(-20) + REAL ESACM20 ! accumulation " + REAL ESCOM20 ! coarse " + + REAL ESATM32 ! Aitken " **(-32) + REAL ESACM32 ! accumulation " + REAL ESCOM32 ! coarse " + + REAL EIM ! Impaction efficiency + +C----------------------------------------------------------------------- + + VDEP = 0.0 ! array assignment + IF ( MOSAIC ) THEN + VDEPJ = 0.0 ! array assignment + END IF + + DO R = 1, SIZE( BLKTA, 2 ) + DO C = 1, SIZE( BLKTA, 1 ) + +C *** Calculate Knudsen numbers + + TWOXLM = XLM( C,R ) + XLM( C,R ) + KNATK = TWOXLM / DGATK( C,R ) + KNACC = TWOXLM / DGACC( C,R ) + KNCOR = TWOXLM / DGCOR( C,R ) + +C *** Calculate functions of variable standard deviation. + + L2SGAT = XXLSGAT( C,R ) * XXLSGAT( C,R ) + L2SGAC = XXLSGAC( C,R ) * XXLSGAC( C,R ) + L2SGCO = XXLSGCO( C,R ) * XXLSGCO( C,R ) + + EAT1 = EXP( 0.125 * L2SGAT ) + EAC1 = EXP( 0.125 * L2SGAC ) + ECO1 = EXP( 0.125 * L2SGCO ) + + ESAT04 = EAT1 ** 4 + ESAC04 = EAC1 ** 4 + ESCO04 = ECO1 ** 4 + + ESAT08 = ESAT04 * ESAT04 + ESAC08 = ESAC04 * ESAC04 + ESCO08 = ESCO04 * ESCO04 + + ESAT12 = ESAT04 * ESAT08 + ESAC12 = ESAC04 * ESAC08 + ESCO12 = ESCO04 * ESCO08 + + ESAT16 = ESAT08 * ESAT08 + ESAC16 = ESAC08 * ESAC08 + ESCO16 = ESCO08 * ESCO08 + + ESAT20 = ESAT16 * ESAT04 + ESAC20 = ESAC16 * ESAC04 + ESCO20 = ESCO16 * ESCO04 + + ESAT28 = ESAT20 * ESAT08 + ESAC28 = ESAC20 * ESAC08 + ESCO28 = ESCO20 * ESCO08 + + ESAT32 = ESAT16 * ESAT16 + ESAC32 = ESAC16 * ESAC16 + ESCO32 = ESCO16 * ESCO16 + + ESAT36 = ESAT16 * ESAT20 + ESAC36 = ESAC16 * ESAC20 + ESCO36 = ESCO16 * ESCO20 + + ESAT48 = ESAT36 * ESAT12 + ESAC48 = ESAC36 * ESAC12 + ESCO48 = ESCO36 * ESCO12 + + ESAT64 = ESAT32 * ESAT32 + ESAC64 = ESAC32 * ESAC32 + ESCO64 = ESCO32 * ESCO32 + + ESAT128 = ESAT64 * ESAT64 + ESAC128 = ESAC64 * ESAC64 + ESCO128 = ESCO64 * ESCO64 + + ESAT160 = ESAT128* ESAT32 + ESAC160 = ESAC128* ESAC32 + ESCO160 = ESCO128* ESCO32 + +C *** calculate inverses: + + ESATM12 = 1.0 / ESAT12 + ESACM12 = 1.0 / ESAC12 + ESCOM12 = 1.0 / ESCO12 + + ESATM16 = 1.0 / ESAT16 + ESACM16 = 1.0 / ESAC16 + ESCOM16 = 1.0 / ESCO16 + + ESATM20 = 1.0 / ESAT20 + ESACM20 = 1.0 / ESAC20 + ESCOM20 = 1.0 / ESCO20 + + ESATM32 = 1.0 / ESAT32 + ESACM32 = 1.0 / ESAC32 + ESCOM32 = 1.0 / ESCO32 + + DCONST1 = BOLTZMANN * BLKTA( C,R ) / ( THREEPI * AMU( C,R ) ) + DCONST1N = DCONST1 / DGATK( C,R ) + DCONST1A = DCONST1 / DGACC( C,R ) + DCONST1C = DCONST1 / DGCOR( C,R ) + DCONST2 = GRAV / ( 18.0 * AMU( C,R ) ) + DCONST3N = DCONST2 * PDENSAT( C,R ) * DGATK( C,R ) * DGATK( C,R ) + DCONST3A = DCONST2 * PDENSAC( C,R ) * DGACC( C,R ) * DGACC( C,R ) + DCONST3C = DCONST2 * PDENSCO( C,R ) * DGCOR( C,R ) * DGCOR( C,R ) + +C i-mode + DCHAT0N = DCONST1N * ( ESAT04 + BHAT * KNATK * ESAT16 ) + DCHAT2N = DCONST1N * ( ESATM12 + BHAT * KNATK * ESATM16 ) + DCHAT3N = DCONST1N * ( ESATM20 + BHAT * KNATK * ESATM32 ) + VGHAT0N = DCONST3N * ( ESAT16 + BHAT * KNATK * ESAT04 ) + VGHAT2N = DCONST3N * ( ESAT48 + BHAT * KNATK * ESAT20 ) + VGHAT3N = DCONST3N * ( ESAT64 + BHAT * KNATK * ESAT28 ) + +C j-mode + DCHAT0A = DCONST1A * ( ESAC04 + BHAT * KNACC * ESAC16 ) + DCHAT2A = DCONST1A * ( ESACM12 + BHAT * KNACC * ESACM16 ) + DCHAT3A = DCONST1A * ( ESACM20 + BHAT * KNACC * ESACM32 ) + VGHAT0A = DCONST3A * ( ESAC16 + BHAT * KNACC * ESAC04 ) + VGHAT2A = DCONST3A * ( ESAC48 + BHAT * KNACC * ESAC20 ) + VGHAT3A = DCONST3A * ( ESAC64 + BHAT * KNACC * ESAC28 ) + +C coarse mode + DCHAT0C = DCONST1C * ( ESCO04 + BHAT * KNCOR * ESCO16 ) + DCHAT2C = DCONST1C * ( ESCOM12 + BHAT * KNCOR * ESCOM16 ) + DCHAT3C = DCONST1C * ( ESCOM20 + BHAT * KNCOR * ESCOM32 ) + VGHAT0C = DCONST3C * ( ESCO16 + BHAT * KNCOR * ESCO04 ) + VGHAT2C = DCONST3C * ( ESCO48 + BHAT * KNCOR * ESCO20 ) + VGHAT3C = DCONST3C * ( ESCO64 + BHAT * KNCOR * ESCO28 ) + +C now calculate the deposition velocities + + NU = AMU( C,R ) / BLKDENS( C,R ) + USTFAC = BLKUSTAR( C,R ) * BLKUSTAR( C,R ) / ( GRAV * NU ) + STOKEN = DCONST3N * USTFAC + STOKEA = DCONST3A * USTFAC + STOKEC = DCONST3C * USTFAC + UTSCALE = BLKUSTAR( C,R ) + & + 0.24 * BLKWSTAR( C,R ) * BLKWSTAR( C,R ) + & / BLKUSTAR( C,R ) + +C first do 0th moment for the deposition of number + +C Aitken mode + SC0N = NU / DCHAT0N + EIM = STOKEN ** 2 / 400.0 * ESAT64 + EIM = MIN( EIM, 1.0 ) + RD0N = 1.0 / ( UTSCALE * ( SC0N ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDNATK ) = VGHAT0N + & / ( 1.0 - EXP( -VGHAT0N * ( BLKRA( C,R ) + RD0N ) ) ) + +C accumulation mode + SC0A = NU / DCHAT0A + EIM = STOKEA ** 2 / 400.0 * ESAC64 + EIM = MIN( EIM, 1.0 ) + RD0A = 1.0 / ( UTSCALE * ( SC0A ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDNACC ) = VGHAT0A + & / ( 1.0 - EXP( -VGHAT0A * ( BLKRA( C,R ) + RD0A ) ) ) + +C coarse mode + SC0C = NU / DCHAT0C + EIM = STOKEC ** 2 / 400.0 * ESCO64 + EIM = MIN( EIM, 1.0 ) + RD0C = 1.0 / ( UTSCALE * ( SC0C ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDNCOR ) = VGHAT0C + & / ( 1.0 - EXP( -VGHAT0C * ( BLKRA( C,R ) + RD0C ) ) ) + +C now do 2nd moment for the deposition of surface area + +C Aitken mode + SC2N = NU / DCHAT2N + EIM = STOKEN ** 2 / 400.0 * ESAT128 + EIM = MIN( EIM, 1.0 ) + RD2N = 1.0 / ( UTSCALE * ( SC2N ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDSATK ) = VGHAT2N + & / ( 1.0 - EXP( -VGHAT2N * ( BLKRA( C,R ) + RD2N ) ) ) + +C accumulation mode + SC2A = NU / DCHAT2A + EIM = STOKEA ** 2 / 400.0 * ESAC128 + EIM = MIN( EIM, 1.0 ) + RD2A = 1.0 / ( UTSCALE * ( SC2A ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDSACC ) = VGHAT2A + & / ( 1.0 - EXP( -VGHAT2A * ( BLKRA( C,R ) + RD2A ) ) ) + +C coarse mode + SC2C = NU / DCHAT2C + EIM = STOKEC ** 2 / 400.0 * ESCO128 + EIM = MIN( EIM, 1.0 ) + RD2C = 1.0 / ( UTSCALE * ( SC2C ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDSCOR ) = VGHAT2C + & / ( 1.0 - EXP( -VGHAT2C * ( BLKRA( C,R ) + RD2C ) ) ) + +C now do 3rd moment for the deposition of mass + +C Aitken mode + SC3N = NU / DCHAT3N + EIM = STOKEN ** 2 / 400.0 * ESAT160 + EIM = MIN( EIM, 1.0 ) + RD3N = 1.0 / ( UTSCALE * ( SC3N ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDMATK ) = VGHAT3N + & / ( 1.0 - EXP( -VGHAT3N * ( BLKRA( C,R ) + RD3N ) ) ) + +C accumulation mode + SC3A = NU / DCHAT3A + EIM = STOKEA ** 2 / 400.0 * ESAC160 + EIM = MIN( EIM, 1.0 ) + RD3A = 1.0 / ( UTSCALE * ( SC3A ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDMACC ) = VGHAT3A + & / ( 1.0 - EXP( -VGHAT3A * ( BLKRA( C,R ) + RD3A ) ) ) + +C coarse mode + SC3C = NU / DCHAT3C + EIM = STOKEC ** 2 / 400.0 * ESCO160 + EIM = MIN( EIM, 1.0 ) + RD3C = 1.0 / ( UTSCALE * ( SC3C ** ( -TWO3 ) + EIM ) ) + + VDEP( C,R,VDMCOR ) = VGHAT3C + & / ( 1.0 - EXP( -VGHAT3C * ( BLKRA( C,R ) + RD3C ) ) ) + +C Do mosaic calculations - essentially a repeat of the above, using the mosaic vars + IF ( MOSAIC ) THEN + + DO J = 1, N_LUFRAC + IF ( BLKRAJ( J,C,R ) .GT. 0.0 ) THEN + +C now calculate the deposition velocities + + NU = AMU( C,R ) / BLKDENS( C,R ) + USTFAC = BLKUSTARJ( J,C,R ) * BLKUSTARJ( J,C,R ) / ( GRAV * NU ) + STOKEN = DCONST3N * USTFAC + STOKEA = DCONST3A * USTFAC + STOKEC = DCONST3C * USTFAC + UTSCALE = BLKUSTARJ( J,C,R ) + & + 0.24 * BLKWSTAR( C,R ) * BLKWSTAR( C,R ) + & / BLKUSTARJ( J,C,R ) + +C first do 0th moment for the deposition of number + +C Aitken mode + + SC0N = NU / DCHAT0N + EIM = STOKEN ** 2 / 400.0 * ESAT64 + EIM = MIN( EIM, 1.0 ) + RD0N = 1.0 / ( UTSCALE * ( SC0N ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDNATK ) = VGHAT0N + & / ( 1.0 - EXP(-VGHAT0N * ( BLKRAJ( J,C,R ) + RD0N ) ) ) + +C accumulation mode + + SC0A = NU / DCHAT0A + EIM = STOKEA ** 2 / 400.0 * ESAC64 + EIM = MIN( EIM, 1.0 ) + RD0A = 1.0 / ( UTSCALE * ( SC0A ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDNACC ) = VGHAT0A + & / ( 1.0 - EXP(-VGHAT0A * ( BLKRAJ( J,C,R ) + RD0A ) ) ) + +C coarse mode + + SC0C = NU / DCHAT0C + EIM = STOKEC ** 2 / 400.0 * ESCO64 + EIM = MIN( EIM, 1.0 ) + RD0C = 1.0 / ( UTSCALE * ( SC0C ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDNCOR ) = VGHAT0C + & / ( 1.0 - EXP(-VGHAT0C * ( BLKRAJ( J,C,R ) + RD0C ) ) ) + +C now do 2nd moment for the deposition of surface area + +C Aitken mode + + SC2N = NU / DCHAT2N + EIM = STOKEN ** 2 / 400.0 * ESAT128 + EIM = MIN( EIM, 1.0 ) + RD2N = 1.0 / ( UTSCALE * ( SC2N ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDSATK ) = VGHAT2N + & / ( 1.0 - EXP(-VGHAT2N * ( BLKRAJ( J,C,R ) + RD2N ) ) ) + +C accumulation mode + + SC2A = NU / DCHAT2A + EIM = STOKEA ** 2 / 400.0 * ESAC128 + EIM = MIN( EIM, 1.0 ) + RD2A = 1.0 / ( UTSCALE * ( SC2A ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDSACC ) = VGHAT2A + & / ( 1.0 - EXP(-VGHAT2A * ( BLKRAJ( J,C,R ) + RD2A ) ) ) + +C coarse mode + + SC2C = NU / DCHAT2C + EIM = STOKEC ** 2 / 400.0 * ESCO128 + EIM = MIN( EIM, 1.0 ) + RD2C = 1.0 / ( UTSCALE * ( SC2C ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDSCOR ) = VGHAT2C + & / ( 1.0 - EXP(-VGHAT2C * ( BLKRAJ( J,C,R ) + RD2C ) ) ) + +C now do 3rd moment for the deposition of mass + +C Aitken mode + + SC3N = NU / DCHAT3N + EIM = STOKEN ** 2 / 400.0 * ESAT160 + EIM = MIN( EIM, 1.0 ) + RD3N = 1.0 / ( UTSCALE * ( SC3N ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDMATK ) = VGHAT3N + & / ( 1.0 - EXP(-VGHAT3N * ( BLKRAJ( J,C,R ) + RD3N ) ) ) + +C accumulation mode + + SC3A = NU / DCHAT3A + EIM = STOKEA ** 2 / 400.0 * ESAC160 + EIM = MIN( EIM, 1.0 ) + RD3A = 1.0 / ( UTSCALE * ( SC3A ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDMACC ) = VGHAT3A + & / ( 1.0 - EXP(-VGHAT3A * ( BLKRAJ( J,C,R ) + RD3A ) ) ) + +C coarse mode + + SC3C = NU / DCHAT3C + EIM = STOKEC ** 2 / 400.0 * ESCO160 + EIM = MIN( EIM, 1.0 ) + RD3C = 1.0 / ( UTSCALE * ( SC3C ** ( -TWO3 ) + EIM ) ) + + VDEPJ( J,C,R,VDMCOR ) = VGHAT3C + & / ( 1.0 - EXP(-VGHAT3C * ( BLKRAJ( J,C,R ) + RD3C ) ) ) + + END IF ! RAJ > 0 + + END DO ! n_lufrac + + END IF ! mosaic + END DO ! end loop on C + END DO ! end loop on R + + RETURN + END SUBROUTINE GETDEP_V diff --git a/models/CCTM/aero/blank/aero_driver.F b/models/CCTM/aero/blank/aero_driver.F new file mode 100755 index 0000000..e095828 --- /dev/null +++ b/models/CCTM/aero/blank/aero_driver.F @@ -0,0 +1,592 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/aero_driver.F,v 1.11 2012/01/19 13:12:57 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C >>> 08/04/2000 Changes necessary to be able to read and process +C two different types of emissions files. +C the first type is the existing opperational PM2.5 & PM10 unspeciated +C file. The new file format has speciated emissions. +C >>> This version uses the FORTRAN 90 feature for runtime memory +C allocation. + +C 1/12/99 David Wong at LM: +C -- introduce new variable MY_NUMBLKS (eliminate NUMBLKS) +C -- re-calculate NOXYZ accordingly +C FSB Updated for inclusion of surface area / second moment +C 25 Sep 00 (yoj) various bug fixes, cleanup to coding standards +C Jeff - Dec 00 - move CGRID_MAP into f90 module +C FSB/Jeff - May 01 - optional emissions processing +C Jerry Gipson - Jun 01 - added SOA linkages for saprc99 +C Bill Hutzell - Jun 01 - simplified CBLK mapping +C Jerry Gipson - Jun 03 - modified for new soa treatment +C Jerry Gipson - Aug 03 - removed SOA prod form alkenes & added +C emission adjustment factors for ALK & TOL ( RADM2 & SAPRC99 only) +C Shawn Roselle - Jan 04 +C - removed SOA from transported aerosol surface area +C - fixed bug in calculation of wet parameters. Previously, DRY aerosol +C parameters were being written to the AERDIAG files and mislabeled +C as WET. +C Prakash Bhave - May 04 +C - changed AERODIAG species (added RH; removed M0 & M2dry) +C Jeff Young - Jan 05 - dyn alloc +C - establish both horizontal & vertical domain specifications in one module +c Uma Shankar and Prakash Bhave - Jun 05 +c - added code to handle the following species: ANAI, ANAJ, ANAK, ACLI, +c ACLJ, ACLK, ASO4K, AH2OK, ANO3K, and HCL; removed code for ASEAS +c - removed obsolete MW variables +C Prakash Bhave - Jul 05 - added PM25 mass-fraction calculations +C Jeff Young - Feb 06 - trap fractional humidity above 0.005 +C Prakash Bhave - Apr 06 - added GAMMA_N2O5 to the AEROPROC call vector +C and the aerosol diagnostic file +C Prakash Bhave - May 06 - changed units of DG variables from m to um in +C the aerosol diagnostic file as suggested by Dr. Bill Hutzell +C Sergey Napelenok - Sep 07 - SOA updates +C - added code to handle the following species: AALKJ, ATOL1J, ATOL2J, +C ATOL3J, AXYL1J, AXYL2J, AXYL3J, ABNZ1J, ABNZ2J, ABNZ3J, AISO1J, AISO2J, +C AISO3J, ATRP1J, ATRP2J, ASQTJ, AORGCJ, TOLNRXN, TOLHRXN, XYLNRXN, +C XYLHRXN, BNZNRXN, BNZHRXN, ISOPRXN, and SESQRXN +C - removed following species: AORGAI, AORGAJ, AORGBI, AORGBJ, OLIRXN, +C CSLRXN, TOLRXN, XYLRXN +C Prakash Bhave - Oct 07 - SOA updates +C - added semi-volatile vapors to the CBLK array; moved ppm -> ug/m3 unit +C conversion from the ORGAER subroutine to this program +C - updated definition of DRY aerosol to include nonvolatile SOA species +C - removed adjustment factors for TOLAER (SPTOL, RDTOL) because benzene is +C now an explicit species so all of the reacted TOL can produce SOA +C - removed code to handle TERPSP (obsolete); renamed TERPRXN as TRPRXN +C David Wong - Jan 08 - rearranged calculation of dry 3rd moments to avoid +C NaN on some compilers (using the M3SUBT variable) +C Prakash Bhave - Jan 08 - updated MECHNAME check from AE4 to AE5 +C Golam Sarwar - Mar 08 - added a heterogeneous reaction producing HONO +C Jim Kelly - Apr 08 - coarse mode updates +C - added code to account for new species (ANH4K & SRFCOR) and variable +C coarse std. deviation +C - removed MW coding now located in AERO_INFO.f +C - added LIMIT_Sg flag for call to GETPAR +C Jeff Young - Aug 10 - convert for Namelist redesign (replace include files) +C Steve Howard - Mar 11 - Renamed met_data to aeromet_data +C S.Roselle- Mar 11 - replaced I/O API include files with UTILIO_DEFN +C David Wong - Aug 11 - put in twoway model implementation +C David Wong - Oct 11 - extended the twoway implementation to handle finer +C time resolution +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE AERO ( CGRID, JDATE, JTIME, TSTEP ) + + USE GRID_CONF ! horizontal & vertical domain specifications + + USE AERO_DATA ! aero variable data + USE PRECURSOR_DATA ! gas phase aero precursor data + USE SOA_DEFN ! gas soa data + USE AEROMET_DATA ! air properties data, eg., T, P, RH includes CONST.EXT + USE UTILIO_DEFN + USE CGRID_SPCS + + IMPLICIT NONE + +C *** Includes: + + INCLUDE SUBST_RXCMMN ! to get mech name + INCLUDE SUBST_FILES_ID ! file name parameters (req IOPARMS) + INCLUDE SUBST_PACTL_ID ! process analysis + +C *** Arguments: + +C *** CGRID is conc field (including gas and aerosol variables) + REAL, POINTER :: CGRID( :,:,:,: ) ! concentrations + INTEGER JDATE ! Current model date , coded YYYYDDD + INTEGER JTIME ! Current model time , coded HHMMSS + INTEGER TSTEP( 3 ) ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + ! TSTEP(2) = sciproc sync. step (chem) + ! TSTEP(3) = twoway model time step w.r.t. wrf time + ! step and wrf/cmaq call frequency + + INTEGER, SAVE :: LOGDEV ! unit number for the log file + +C *** Local Variables: + + CHARACTER( 16 ), SAVE :: PNAME = 'AERO_DRIVER' + CHARACTER( 16 ) :: VNAME ! variable name + CHARACTER( 96 ) :: XMSG = ' ' + + INTEGER MDATE, MTIME, MSTEP ! julian date, time and + ! timestep in sec + INTEGER C, R, L, V, N ! loop counters + INTEGER SPC ! species loop counter + INTEGER STRT, FINI ! loop induction variables + INTEGER ALLOCSTAT ! memory allocation status + + LOGICAL LERROR ! Error flag + +C *** Grid Description + REAL DX1 ! Cell x-dimension + REAL DX2 ! Cell y-dimension + INTEGER GXOFF, GYOFF ! global origin offset from file +C for INTERPX + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + +C *** Variable to set time step for writing visibility file + INTEGER, SAVE :: WSTEP = 0 ! local write counter + LOGICAL, SAVE :: WRITETIME = .FALSE. ! local write flag + +C *** meteorological variables + REAL PRES ( NCOLS,NROWS,NLAYS ) ! Atmospheric pressure [ Pa ] + REAL TA ( NCOLS,NROWS,NLAYS ) ! Air temperature [ K ] + REAL DENS ( NCOLS,NROWS,NLAYS ) ! Air density [ kg/m**-3 ] + REAL QV ( NCOLS,NROWS,NLAYS ) ! Water vapor mixing ratio [ kg/kg ] + +C *** variables computed and output but not carried in CGRID + +C *** visibility variables + INTEGER, PARAMETER :: N_AE_VIS_SPC = 4 + INTEGER, PARAMETER :: IDCVW1 = 1 ! visual range in deciview (Mie) + INTEGER, PARAMETER :: IBEXT1 = 2 ! extinction [ 1/km ] (Mie) + INTEGER, PARAMETER :: IDCVW2 = 3 ! visual range in deciview (Reconst) + INTEGER, PARAMETER :: IBEXT2 = 4 ! extinction [ 1/km ] (Reconst) + REAL VIS_SPC( NCOLS,NROWS,N_AE_VIS_SPC ) ! Visual range information + +C *** aerosol size distribution variables + REAL DIAM_SPC( NCOLS,NROWS,NLAYS,23 ) + +C *** atmospheric properties + REAL XLM ! atmospheric mean free path [ m ] + REAL AMU ! atmospheric dynamic viscosity [ kg/m s ] + +C *** N2O5 heterogeneous reaction probability [ ] + REAL GAMMA_N2O5 ! computed in SUBROUTINE EQL3 + +C *** mass fraction of each mode less than 2.5um aerodynamic diameter + REAL PM25( N_MODE ) ! fine fractions + +C *** visual range information + REAL BLKDCV1 ! block deciview (Mie) + REAL BLKEXT1 ! block extinction [ km**-1 ] (Mie) + + REAL BLKDCV2 ! block deciview (Reconstructed) + REAL BLKEXT2 ! block extinction [ km**-1 ] (Reconstructed) + +C *** other internal aerosol variables + INTEGER IND ! index to be used with INDEX1 + +C *** synchronization time step [ s ] + REAL DT + +C *** variables to set up for "dry transport " + REAL M3_WET, M3_DRY ! third moment with and without water + REAL M2_WET, M2_DRY ! second moment with and without water + REAL M3SUBT ! temp variable for dry 3rd moment calcs + +C *** flag to include water in the 3rd moment calculation + LOGICAL, PARAMETER :: M3_WET_FLAG = .FALSE. + +C *** if LIMIT_Sg = T, atkn & accum std. dev. are not changed by GETPAR + LOGICAL, PARAMETER :: LIMIT_Sg = .FALSE. + +C *** variables aerosol diagnostic file flag + INTEGER STATUS ! ENV... status + CHARACTER( 80 ) :: VARDESC ! environment variable description + +C *** environment variable for AERDIAG file + CHARACTER( 16 ), SAVE :: CTM_AERDIAG = 'CTM_AERDIAG' + +C *** flag for AERDIAG file [F], default + LOGICAL, SAVE :: AERDIAG + +C *** first pass flag + LOGICAL, SAVE :: FIRSTIME = .TRUE. + +C *** ratio of molecular weights of water vapor to dry air = 0.622015 + REAL, PARAMETER :: EPSWATER = MWWAT / MWAIR + +C *** dry moment factor + REAL, PARAMETER :: TWOTHIRDS = 2.0 / 3.0 + + LOGICAL :: TIME_TO_CALL_FEEDBACK_WRITE + LOGICAL, SAVE :: CMAQ_WRF_FEEDBACK + +C *** Statement Function ************** + REAL ESATL ! arithmetic statement function for vapor pressure [Pa] + REAL TT +C *** Coefficients for the equation, ESATL defining saturation vapor pressure + REAL, PARAMETER :: AL = 610.94 + REAL, PARAMETER :: BL = 17.625 + REAL, PARAMETER :: CL = 243.04 + + INTEGER, SAVE :: O3 + +C *** values of AL, BL, and CL are from: +C Alduchov and Eskridge, "Improved Magnus Form Approximations of +C Saturation Vapor Pressure," +C Jour. of Applied Meteorology, vol. 35, +C pp 601-609, April, 1996. + + ESATL( TT ) = AL * EXP( BL * ( TT - 273.15 ) / ( TT - 273.15 + CL ) ) + +C *** End Statement Function ******** + + logical, save :: now = .true. + +#ifdef twoway + INTERFACE + SUBROUTINE FEEDBACK_WRITE (C, R, L, CGRID_DATA, O3_VALUE, JDATE, JTIME) + REAL, INTENT(IN) :: CGRID_DATA(:), O3_VALUE + INTEGER, INTENT(IN) :: C, R, L, JDATE, JTIME + END SUBROUTINE FEEDBACK_WRITE + END INTERFACE +#endif + +C ------------------ begin body of AERO_DRIVER ------------------------- + + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. + LOGDEV = INIT3() + +#ifdef twoway +! -- this is for twoway + VNAME = 'O3' + N = INDEX1( VNAME, N_GC_CONC, GC_CONC ) + IF ( N .NE. 0 ) THEN + O3 = GC_STRT - 1 + GC_CONC_MAP( N ) + ELSE + XMSG = 'Could not find ' // VNAME // 'in gas chem aerosol table' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF +#endif + +C *** Get aerosol diagnostic file flag. + AERDIAG = .FALSE. ! default + VARDESC = 'Flag for writing the aerosol diagnostic file' + AERDIAG = ENVYN( CTM_AERDIAG, VARDESC, AERDIAG, STATUS ) + IF ( STATUS .NE. 0 ) WRITE( LOGDEV, '(5X, A)' ) VARDESC + IF ( STATUS .EQ. 1 ) THEN + XMSG = 'Environment variable improperly formatted' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + 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 + +C *** Open the met files. + IF ( .NOT. OPEN3( MET_CRO_3D, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open MET_CRO_3D file ' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + IF ( .NOT. OPEN3( MET_CRO_2D, FSREAD3, PNAME ) ) THEN + XMSG = 'Could not open MET_CRO_2D file ' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** Set up file structure for visibility file. It has two variables, +C visual range in deciview units (dimensionless) and extinction in +C units of (1/km) and is for layer 1 only. + IF ( MYPE .EQ. 0 ) CALL OPVIS ( JDATE, JTIME, TSTEP( 1 ) ) + +C *** Open the aerosol parameters file (diameters and standard deviations). + IF ( AERDIAG .AND. MYPE .EQ. 0 ) + & CALL OPDIAM ( JDATE, JTIME, TSTEP( 1 ) ) + +C *** Get domain decomp info from the MET_CRO_3D file + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + +#ifdef twoway + CMAQ_WRF_FEEDBACK = ENVYN( 'CMAQ_WRF_FEEDBACK', ' ', .FALSE., STATUS ) + IF ( STATUS .EQ. 1 ) THEN + PRINT *, 'Environment variable improperly formatted' + STOP + ELSE IF ( STATUS .EQ. -1 ) THEN + PRINT *, 'Environment variable set, but empty ... Using default:' + ELSE IF ( STATUS .EQ. -2 ) THEN + PRINT *, 'Environment variable not set ... Using default:' + END IF +#endif + + END IF ! FIRSTIME + + MDATE = JDATE + MTIME = JTIME + MSTEP = TIME2SEC( TSTEP( 2 ) ) + CALL NEXTIME ( MDATE, MTIME, SEC2TIME( MSTEP / 2 ) ) + + WSTEP = WSTEP + TIME2SEC( TSTEP( 2 ) ) + IF ( WSTEP .GE. TIME2SEC( TSTEP( 1 ) ) ) WRITETIME = .TRUE. + +C *** Set floating point synchronization time step: + DT = FLOAT( MSTEP ) ! set time step in seconds + +C *** Get Meteorological Variables + +C *** pressure [Pa] + VNAME = 'PRES' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MDATE, MTIME, PRES ) ) THEN + XMSG = 'Could not interpolate '// TRIM( VNAME ) // ' from MET_CRO_3D ' + CALL M3EXIT ( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +C *** temperature [K] + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MDATE, MTIME, TA ) ) THEN + XMSG = 'Could not interpolate '// TRIM( VNAME ) // ' from MET_CRO_3D ' + CALL M3EXIT ( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +C *** specific humidity [g H2O/g air] + VNAME = 'QV' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MDATE, MTIME, QV ) ) THEN + XMSG = 'Could not interpolate '// TRIM( VNAME ) // ' from MET_CRO_3D ' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C *** air density [kg/m3] + VNAME = 'DENS' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MDATE, MTIME, DENS ) ) THEN + XMSG = 'Could not interpolate '// TRIM( VNAME ) // ' from MET_CRO_3D ' + CALL M3EXIT ( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + +#ifdef twoway +! call FEEDBACK_WRITE when JTIME is mulitple of WRF time step + IF ( CMAQ_WRF_FEEDBACK ) THEN + IF ( MOD( TIME2SEC(MOD( JTIME, 10000 )), TIME2SEC(TSTEP( 3 )) ) .EQ. 0 ) THEN + TIME_TO_CALL_FEEDBACK_WRITE = .TRUE. + ELSE + TIME_TO_CALL_FEEDBACK_WRITE = .FALSE. + END IF + END IF +#endif + +c$$$C --------------------- Begin loops over grid cells -------------------------- +c$$$ +c$$$C *** initialize conc arrays +c$$$ +c$$$ DO L = 1, NLAYS +c$$$ DO R = 1, MY_NROWS +c$$$ DO C = 1, MY_NCOLS +c$$$ +c$$$C *** Grid cell meteorological data. +c$$$ AIRTEMP = TA ( C,R,L ) +c$$$ AIRPRES = PRES ( C,R,L ) ! Note pascals +c$$$ AIRQV = QV ( C,R,L ) +c$$$ AIRDENS = DENS ( C,R,L ) +c$$$ H2OSATVP = ESATL( AIRTEMP ) +c$$$ H2OVP = AIRPRES * AIRQV / ( EPSWATER + AIRQV ) +c$$$ AIRRH = MAX( 0.005, MIN( 0.99, H2OVP / H2OSATVP ) ) +c$$$ +c$$$C *** Extract grid cell concentrations of aero species from CGRID +c$$$C into aerospc_conc in aero_data module (set minimum) +c$$$ CALL EXTRACT_AERO( CGRID( C,R,L,: ), .TRUE. ) +c$$$ +c$$$C *** Extract grid cell concentrations of gas precursors from CGRID (ppm) +c$$$C into precursr_conc in precursor_data +c$$$ CALL EXTRACT_PRECURSOR( CGRID( C,R,L,: ) ) +c$$$ +c$$$C *** Calculate SO4RATE stored in module +c$$$ SO4RATE = PRECURSOR_CONC( SULPRD_IDX ) / DT +c$$$ +c$$$C *** Extract soa concentrations from CGRID +c$$$ CALL EXTRACT_SOA( CGRID( C,R,L,: ) ) +c$$$ +c$$$C *** Aerosol process routines +c$$$ CALL AEROPROC( DT, C, R, L, GAMMA_N2O5 ) +c$$$ +c$$$C *** Update aerosol variables conc back into CGRID (set minimum) +c$$$ CALL UPDATE_AERO( CGRID( C,R,L,: ), .TRUE. ) +c$$$ +c$$$C *** Update precursor variables conc back into CGRID +c$$$ CALL UPDATE_PRECURSOR( CGRID( C,R,L,: ) ) +c$$$ +c$$$C *** Update gas soa concentrations back to CGRID +c$$$ CALL UPDATE_SOA( CGRID( C,R,L,: ) ) +c$$$ +c$$$C *** Calculate volume fraction of each mode < 2.5um aerodynamic diameter +c$$$ DO N = 1, N_MODE +c$$$ CALL INLET25 ( AEROMODE_DIAM( N ), AEROMODE_SDEV( N ), +c$$$ & AEROMODE_DENS( N ), PM25( N ) ) +c$$$ END DO +c$$$ +c$$$C *** Write aerosol extinction coefficients and deciviews to visibility +c$$$C diagnostic array (lowest vertical layer only) +c$$$ +c$$$ IF ( WRITETIME .AND. L .EQ. 1 ) THEN +c$$$ +c$$$ CALL GETVISBY( BLKDCV1, BLKEXT1, BLKDCV2, BLKEXT2 ) +c$$$ +c$$$ VIS_SPC( C,R,IDCVW1 ) = BLKDCV1 ! Mie visual range [deciview] +c$$$ VIS_SPC( C,R,IBEXT1 ) = BLKEXT1 ! Mie aero extinction [1/km] +c$$$ VIS_SPC( C,R,IDCVW2 ) = BLKDCV2 ! Reconstructed visual range [deciview] +c$$$ VIS_SPC( C,R,IBEXT2 ) = BLKEXT2 ! Reconstructed aero extinction [1/km] +c$$$ +c$$$ END IF +c$$$ +c$$$C *** Write wet diameters, 2nd, and 3rd moments to aerosol diagnostic array +c$$$C This assumes that GETPAR was last called with M3_WET_FLAG = .TRUE. +c$$$ IF ( WRITETIME .AND. AERDIAG ) THEN +c$$$ DIAM_SPC( C,R,L, 7 ) = AEROMODE_DIAM( 1 ) * 1.0E6 ! wet i-mode diam. +c$$$ DIAM_SPC( C,R,L, 8 ) = AEROMODE_DIAM( 2 ) * 1.0E6 ! wet j-mode diam. +c$$$ DIAM_SPC( C,R,L, 9 ) = AEROMODE_DIAM( 3 ) * 1.0E6 ! wet k-mode diam. +c$$$ DIAM_SPC( C,R,L,10 ) = MOMENT2_CONC( 1 ) ! wet i-mode 2nd moment +c$$$ DIAM_SPC( C,R,L,11 ) = MOMENT2_CONC( 2 ) ! wet j-mode 2nd moment +c$$$ DIAM_SPC( C,R,L,12 ) = MOMENT2_CONC( 3 ) ! wet k-mode 2nd moment +c$$$ DIAM_SPC( C,R,L,16 ) = MOMENT3_CONC( 1 ) ! wet i-mode 3rd moment +c$$$ DIAM_SPC( C,R,L,17 ) = MOMENT3_CONC( 2 ) ! wet j-mode 3rd moment +c$$$ DIAM_SPC( C,R,L,18 ) = MOMENT3_CONC( 3 ) ! wet k-mode 3rd moment +c$$$ DIAM_SPC( C,R,L,20 ) = PM25( 1 ) ! i-mode fine fraction +c$$$ DIAM_SPC( C,R,L,21 ) = PM25( 2 ) ! j-mode fine fraction +c$$$ DIAM_SPC( C,R,L,22 ) = PM25( 3 ) ! coarse-mode fine fraction +c$$$ DIAM_SPC( C,R,L,23 ) = GAMMA_N2O5 ! N2O5 heterorxn probability +c$$$ END IF ! WRITETIME .AND. AERDIAG +c$$$ +c$$$C *** Calculate 2nd and 3rd moments of the "dry" aerosol distribution +c$$$C NOTE! "dry" aerosol excludes both H2O and SOA (Jan 2004 --SJR) +c$$$C EXCEPT! nonvolatile SOA is part of dry aerosol (Oct 2007 --PVB) +c$$$ +c$$$C Aitken mode +c$$$ M3_WET = MOMENT3_CONC( 1 ) +c$$$ M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) +c$$$ & * AEROSPC_CONC( AH2O_IDX,1 ) +c$$$ M3_DRY = M3_WET - M3SUBT +c$$$ M2_WET = MOMENT2_CONC( 1 ) +c$$$ M2_DRY = M2_WET * ( M3_DRY / M3_WET ) ** TWOTHIRDS +c$$$ +c$$$ MOMENT3_CONC( 1 ) = MAX( CONMIN, M3_DRY ) +c$$$ MOMENT2_CONC( 1 ) = MAX( CONMIN, M2_DRY ) +c$$$ +c$$$C accumulation mode +c$$$ M3_WET = MOMENT3_CONC( 2 ) +c$$$ +c$$$ M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) +c$$$ & * AEROSPC_CONC( AH2O_IDX,2 ) +c$$$ DO SPC = 1, N_VAPOR +c$$$ M3SUBT = M3SUBT +c$$$ & + ( 1.0E-9 * F6PI / AEROSPC( APOC_IDX )%DENSITY ) +c$$$ & * AEROSPC_CONC( SOA_AEROMAP( SPC ),2 ) +c$$$ END DO +c$$$ +c$$$ M3_DRY = M3_WET - M3SUBT +c$$$ M2_WET = MOMENT2_CONC( 2 ) +c$$$ M2_DRY = M2_WET * ( M3_DRY / M3_WET ) ** TWOTHIRDS +c$$$ +c$$$ MOMENT3_CONC( 2 ) = MAX( CONMIN, M3_DRY ) +c$$$ MOMENT2_CONC( 2 ) = MAX( CONMIN, M2_DRY ) +c$$$ +c$$$C coarse mode +c$$$ M3_WET = MOMENT3_CONC(3) +c$$$ M3SUBT = ( 1.0E-9 * F6PI / AEROSPC( AH2O_IDX )%DENSITY ) +c$$$ & * AEROSPC_CONC( AH2O_IDX,3 ) +c$$$ M3_DRY = M3_WET - M3SUBT +c$$$ M2_WET = MOMENT2_CONC( 3 ) +c$$$ M2_DRY = M2_WET * ( M3_DRY / M3_WET ) ** TWOTHIRDS +c$$$ +c$$$ MOMENT3_CONC( 3 ) = MAX( CONMIN, M3_DRY ) +c$$$ MOMENT2_CONC( 3 ) = MAX( CONMIN, M2_DRY ) +c$$$ +c$$$C *** Calculate geometric mean diameters and standard deviations of the +c$$$C "dry" size distribution +c$$$ CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) +c$$$ +c$$$C *** Write dry aerosol distribution parameters to aerosol diagnostic array +c$$$ IF ( WRITETIME .AND. AERDIAG ) THEN +c$$$ DIAM_SPC( C,R,L, 1 ) = EXP( AEROMODE_SDEV( 1 ) ) +c$$$ DIAM_SPC( C,R,L, 2 ) = EXP( AEROMODE_SDEV( 2 ) ) +c$$$ DIAM_SPC( C,R,L, 3 ) = EXP( AEROMODE_SDEV( 3 ) ) +c$$$ DIAM_SPC( C,R,L, 4 ) = AEROMODE_DIAM( 1 ) * 1.0E6 ! dry i-mode diam. +c$$$ DIAM_SPC( C,R,L, 5 ) = AEROMODE_DIAM( 2 ) * 1.0E6 ! dry j-mode diam. +c$$$ DIAM_SPC( C,R,L, 6 ) = AEROMODE_DIAM( 3 ) * 1.0e6 ! dry k-mode diam. +c$$$ DIAM_SPC( C,R,L,13 ) = MOMENT3_CONC( 1 ) ! dry i-mode 3rd moment +c$$$ DIAM_SPC( C,R,L,14 ) = MOMENT3_CONC( 2 ) ! dry j-mode 3rd moment +c$$$ DIAM_SPC( C,R,L,15 ) = MOMENT3_CONC( 3 ) ! dry k-mode 3rd moment +c$$$ DIAM_SPC( C,R,L,19 ) = AIRRH ! relative humidity +c$$$ END IF ! WRITETIME .AND. AERDIAG +c$$$ +c$$$C *** Calculate aerosol surface area from the dry 2nd moment. Dry value is +c$$$C used in transport routines. Put aeroSrf values back to CGRID +c$$$ DO N = 1, N_MODE +c$$$ V = AEROSRF_MAP( N ) +c$$$ CGRID( C,R,L,V ) = PI * MOMENT2_CONC( N ) +c$$$ END DO +c$$$ +c$$$#ifdef twoway +c$$$ IF ( CMAQ_WRF_FEEDBACK ) THEN +c$$$ IF ( TIME_TO_CALL_FEEDBACK_WRITE ) THEN +c$$$ CALL FEEDBACK_WRITE ( C, R, L, CGRID(C,R,L,:), CGRID(C,R,L,O3), +c$$$! & aeromode_diam, aeromode_sdev, jdate, jtime) +c$$$ & JDATE, JTIME ) +c$$$ END IF +c$$$ END IF +c$$$#endif +c$$$ +c$$$ END DO ! loop on MY_COLS +c$$$ END DO ! loop on MY_ROWS +c$$$ END DO ! loop on NLAYS +c$$$ +c$$$C *** If last call this hour, write visibility information. +c$$$ IF ( WRITETIME ) THEN +c$$$ MDATE = JDATE +c$$$ MTIME = JTIME +c$$$ CALL NEXTIME ( MDATE, MTIME, TSTEP( 2 ) ) +c$$$ WSTEP = 0 +c$$$ WRITETIME = .FALSE. +c$$$ +c$$$ IF ( .NOT. WRITE3( CTM_VIS_1, ALLVAR3, +c$$$ & MDATE, MTIME, VIS_SPC ) ) THEN +c$$$ XMSG = 'Could not write ' // CTM_VIS_1 // ' file' +c$$$ CALL M3EXIT ( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) +c$$$ END IF +c$$$ +c$$$ WRITE( LOGDEV, '( /5X, 3( A, :, 1X ), I8, ":", I6.6 )' ) +c$$$ & 'Timestep written to', CTM_VIS_1, +c$$$ & 'for date and time', MDATE, MTIME +c$$$ +c$$$C *** Write data to the aerosol diagnostic file. +c$$$ IF ( AERDIAG ) THEN +c$$$ +c$$$ IF ( .NOT. WRITE3( CTM_DIAM_1, ALLVAR3, +c$$$ & MDATE, MTIME, DIAM_SPC ) ) THEN +c$$$ XMSG = 'Could not write ' // CTM_DIAM_1 // ' file' +c$$$ CALL M3EXIT ( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) +c$$$ END IF +c$$$ +c$$$ WRITE( LOGDEV, '( /5X, 3( A, :, 1X ), I8, ":", I6.6 )' ) +c$$$ & 'Timestep written to', CTM_DIAM_1, +c$$$ & 'for date and time', MDATE, MTIME +c$$$ +c$$$ END IF +c$$$ +c$$$ END IF + + RETURN + END diff --git a/models/CCTM/aero/blank/aero_subs.F b/models/CCTM/aero/blank/aero_subs.F new file mode 100755 index 0000000..42f3590 --- /dev/null +++ b/models/CCTM/aero/blank/aero_subs.F @@ -0,0 +1,2876 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/aero_subs.F,v 1.7 2012/01/19 13:14:36 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C routines for aerosol formation and transformation processes + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE AEROPROC( DT, COL, ROW, LAYER, GAMMA_N2O5 ) + +C----------------------------------------------------------------------- +C SUBROUTINE AEROPROC advances the number, second moment, and mass +C concentrations for each mode over the time interval DT. +C +C KEY SUBROUTINES CALLED: +C GETPAR, ORGAER5, HETCHEM, GETCOAGS, INTERCOAG_GH, INTRACOAG_GH, +C VOLINORG +C +C KEY FUNCTIONS CALLED: ERF, ERFC, GETAF +C +C REVISION HISTORY: +C Coded in December 1999 by Dr. Francis S. Binkowski +C Modified from older versions used in CMAQ. +C +C FSB 05/17/00 new version of RPMARES included +C +C FSB 05/30/00 Fixed minor bug in awater.f +C +C FSB Correction to extinction coefficient in getbext. +C +C FSB 07/21/00 corrected units on ORGRATES and ORGBRATE_IN from +C ppm/min to ppm/sec in AEROPROC and AEROSTEP. +C +C FSB 11/30/00 following changes from 07/28/00 +C Fixed problem for new emissions file version +C Combined emissions for M3 +C Used a fixed value of Dpmin for plotting +C Added variables OMEGA_AT & OMEGA_AC for partitioning +C Eliminated the restriction on relative humidity for nucleation. +C Added a branch in EQL for very low relative humidity (<1%). +C +C FSB Following changes to RPMARES: +C Number of iterations reduced from 150 to 50. +C Iterations are used only if 0.5 < = RATIO. +C In calculating the molality of the bisulfate ion, a +C MAX(1.0e-10, MSO4 ) is used. +C +C FSB 08/08/01 Changes to NEWPART to correct mass rate and to AEROSTEP +C to correct sulfate, include emissions, and trap problem in +C accumulation mode number calculation. +C +C FSB 09/19/01 Version AE3, major changes +C Organics are done with Dr. Benedikt Schell's approach. (ORGAER3) +C Particle production uses Kulmala approach (NEWPART3) +C Condensational factors for sulfate and organics are calculated +C separately. +C Emissions are assumed to be input in vertical diffusion. +C Include files replaced by Fortran 90 Modules. +C The modules also contain subroutines. +C +C FSB 10/24/01 Added the treatment of gaseous N2O5 -> aerosol HNO3 +C +C FSB 10/25/01 Changed the mass transfer calculation for Aitken to +C accumulation mode by coagulation as recommended by Dr. Benedikt +C Schell. +C +C SJR 04/24/02 Replaced thermodynamic code RPMARES with ISORROPIA +C --Shawn J. Roselle +C +C GLG 04/04/03 Modifications to allow for evaporation of semi-volatile +C organics from aerosol phase. --Gerald L. Gipson +C +C FSB 11/18/03 Corrections to sulfate condensation. Previously, +C SCONDRATE was undefined when SO4RATE=0 and SCONDRATE was +C negative when SO4RATE < DMDT_so4. +C +C PVB 01/08/04 Several changes in preparation for simulation of 2001 +C calendar year --Dr. Prakash V. Bhave +C -Added interface to new subroutine, GETCOAGS, for calculating +C coagulation rates. GETCOAGS is used instead of Gauss-Hermite +C quadrature for computational efficiency, by setting +C FASTCOAG_FLAG = .TRUE. --PVB +C -Removed SOA from the definition of "DRY" aerosol. Aerosol surface +C area is now transported without SOA. See notes in GETPAR, AERO, +C and AERO_DEPV subroutines. --SJR +C -Moved EQL3 call from AEROPROC to AEROSTEP, immediately following +C the ORGAER3 call. This is a side effect of transporting aerosol +C surface area without SOA. --SJR +C -New subroutine, HCOND3, to calculate condensation rates for +C 2nd and 3rd moments. Results are unchanged. --FSB +C -Revised method of calculating SOA. Partition SOA to the modes +C in proportion to the amounts of total organic mass (SOA plus +C primary) in each mode. Modal geometric standard deviations are +C now preserved during SOA condensation and evaporation. --FSB +C -Combined the former subroutines AEROPROC and AEROSTEP into this +C subroutine; retained the name AEROPROC. --PVB +C +C PVB 09/21/04 added in-line documentation with input from FSB. +C Changed MWH2SO4 from 98.07354 to 98.0 g/mol for consistency with +C the mechanism files. +C +C PVB 09/27/04 removed the IF(XM3.GT.0.0) mode-merging precondition +C because it caused significant erroneous mode crossover. Fix +C suggested by Dr. Chris Nolte. +C +C PVB 01/19/05 Added SO4RATE to the EQL3 call vector. This is necessary +C to ensure that the gas and inorganic fine PM (i+j) concentrations +C are in thermodynamic equilibrium at the end of each time step. +C +C PVB 05/02/05 Modified ERF statement function for negative arguments such +C that erf(-x) = -erf(x). Previous version had erf(-x) = erf(x). +C +C PVB 04/06/06 Added GAMMA_N2O5 to the AEROPROC and EQL3 call vectors, +C so it can be written to the aerosol diagnostic file. +C +C SLN 09/07/07 Several changes in preparation for new SOA module +C -Removed Aitken-mode SOA species (CBLK(VORGAI),CBLK(VORGBI)) and +C all of the related variables (OMASS_I, OMASS_J, FRACI, FRACJ, +C OLD_M2_I, OLD_M3_I, NEW_M2_I, NEW_M3_I) +C -Replaced the other SOA species (CBLK(VORGAJ),CBLK(VORGBJ)) with +C precursor-specific SOA species (e.g., CBLK(VTOL1J)). +C -Replaced SOA_A and SOA_B with an array, SOA_ALL. Replaced +C OLDSOA_A and OLDSOA_B with an array, OLDSOA. Updated ORGAER3 +C call vector accordingly. +C -Removed dependence of mode-merging criteria on SOA condensation +C because that logic was flawed. Deleted all variables needed +C for that calculation (CHEMRATE_ORG, ORGRATE, ORGBRATE). +C +C PVB 11/02/07 Moved heterogenous N2O5 chemistry from EQL3 to a new +C subroutine, HETCHEM. +C +C PVB 11/29/07 Implementation of new SOA formation mechanisms +C -Replaced call to ORGAER3 with a call to ORGAER5 +C -Moved CBLK updates of SV species, SOA species, M2, and M3 into +C ORGAER5 instead of updating those values in AEROPROC +C +C JOY 04/08/08 White space, alignment, readability +C +C JTK 04/17/08 Implemented coarse chemistry updates +C -replaced condensation calculations with call to VOLINORG +C -added code for coarse surface area and variable coarse std. dev. +C -modified modal dynamics equations because new particle formation +C and growth are now calculated in VOLINORG +C +C JOY 12/07/08 Removed unused EQL3 code, add column and row arguments to +C VOLINORG for diagnostic logging +C +C SH 12/17/09 Major restructuring of all aerosol codes +C -use new Fortran modules (e.g., AERO_DATA, SOA_DEFN); shortened call +C vector; replaced CBLK with aerospc structure; eliminated AERO_INFO +C +C SH 03/10/11 Renamed met_data to aeromet_data +C +C HS 03/10/11 Added call to POAAGE between ORGAER and HETCHEM +C +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN +C +C REFERENCES: +C 1. Binkowski, F.S. and U. Shankar, The regional particulate matter +C model 1. Model description and preliminary results, J. Geophys. +C Res., Vol 100, No D12, 26101-26209, 1995. +C +C 2. Binkowski, F.S. and S.J. Roselle, Models-3 Community +C Multiscale Air Quality (CMAQ) model aerosol component 1: +C Model Description. J. Geophys. Res., Vol 108, No D6, 4183 +C doi:10.1029/2001JD001409, 2003. +C +C 3. Bhave, P.V., S.J. Roselle, F.S. Binkowski, C.G. Nolte, S. Yu, +C G.L. Gipson, and K.L. Schere, CMAQ aerosol module development: +C recent enhancements and future plans, Paper No. 6.8, CMAS Annual +C Conference, Chapel Hill, NC, 2004. +C----------------------------------------------------------------------- + + USE AERO_DATA + USE SOA_DEFN + USE AEROMET_DATA + USE UTILIO_DEFN + + IMPLICIT NONE + +C *** arguments: + REAL, INTENT( IN ) :: DT ! synchronization time step, sec + INTEGER, INTENT( IN ) :: COL ! Column of cell + INTEGER, INTENT( IN ) :: ROW ! Row of cell + INTEGER, INTENT( IN ) :: LAYER ! Layer of cell + REAL, INTENT( OUT ) :: GAMMA_N2O5 ! N2O5 heterogeneous reaction probability [ ] + +C *** Parameters + REAL, PARAMETER :: DIFFSULF = 9.36E-06 ! molecular diffusiviity for sulfuric acid + REAL, PARAMETER :: SQRT2 = 1.4142135623731 + REAL, PARAMETER :: T0 = 288.15 ! [ K ] + REAL, PARAMETER :: TWOTHIRDS = 2.0 / 3.0 + +C *** local variables + REAL DIFFCORR ! Correction to DIFFSULF & DIFFORG for pressure + REAL DV_SO4 ! molecular diffusivity of H2SO4 vapor after correction for ambient conditions + REAL SQRT_TEMP ! square root of ambient temperature + REAL XLM ! atmospheric mean free path [m] + REAL AMU ! atmospheric dynamic viscosity [kg/m s] + REAL M2_OLD ! second moment concentration excluding H2O + REAL M3_OLD ! third moment concentration excluding H2O + + REAL( 8 ) :: CGR( N_MODE-1 ) ! Aitken & Accum. modes + + REAL( 8 ) :: LAMDA ! mean free path [ m ] + REAL( 8 ) :: KNC ! KNC = TWO3 * BOLTZ * AIRTEMP / AMU + +C *** Free Molecular regime (depends upon modal density) + REAL( 8 ) :: KFMAT ! = SQRT( 3.0*BOLTZ * AIRTEMP / PDENSAT ) + REAL( 8 ) :: KFMAC ! = SQRT( 3.0*BOLTZ * AIRTEMP / PDENSAC ) + REAL( 8 ) :: KFMATAC ! = SQRT( 6.0*BOLTZ * AIRTEMP / ( PDENSAT + PDENSAC ) ) + +C *** Intermodal coagulation rates [ m**3/s ] ( 0th & 2nd moments ) + REAL( 8 ) :: BATAC( 2 ) ! Aitken to accumulation + REAL( 8 ) :: BACAT( 2 ) ! accumulation from Aitken + +C *** Intramodal coagulation rates [ m**3/s ] ( 0th & 2nd moments ) + REAL( 8 ) :: BATAT( 2 ) ! Aitken mode + REAL( 8 ) :: BACAC( 2 ) ! accumulation mode + +C *** Intermodal coagulation rate [ m**3/s ] ( 3rd moment ) + REAL( 8 ) :: C3IJ ! Aitken to accumulation + REAL( 8 ) :: C30ATAC ! Aitken to accumulation + REAL( 8 ) :: DG_D ( N_MODE ) + REAL( 8 ) :: SG_D ( N_MODE ) + REAL( 8 ) :: XXL_D( N_MODE ) + +C *** variables for advancing concentrations one time step + REAL( 8 ) :: A, B + REAL( 8 ) :: Y0, Y + REAL( 8 ) :: EXPDT + REAL( 8 ) :: LOSS, PROD, POL, LOSSINV + REAL TMASS + REAL FACTRANS ! special factor to compute mass transfer + REAL M20 ! for initial condidtions in time stepping + +C *** Variables for mode merging + REAL GETAF + REAL AAA, XNUM, XM2, XM3,XXM2, XXM3 + REAL FNUM, FM2, FM3, PHNUM, PHM2, PHM3 + REAL ERF, ERFC ! Error and complementary error function + REAL XX ! dummy argument for ERF and ERFC + +C *** local variables + INTEGER SPC ! loop counter + INTEGER N ! loop counter + LOGICAL M3_WET_FLAG + LOGICAL :: LIMIT_Sg = .FALSE. + + integer, save :: logdev + logical, save :: firstime = .true. +C----------------------------------------------------------------------- + + if ( firstime ) then + firstime = .false. + logdev = init3() +#ifdef nomm + write( logdev,* ) 'aero_subs: nomm' +#endif + end if + +C *** square root of the ambient temperature for later use + SQRT_TEMP = SQRT( AIRTEMP ) + +C *** Calculate mean free path [ m ]: +C 6.6328E-8 is the sea level value given in Table I.2.8 +C on page 10 of U.S. Standard Atmosphere 1962 + + XLM = 6.6328E-8 * STDATMPA * AIRTEMP / ( T0 * AIRPRES ) + +C *** Calculate dynamic viscosity [ kg m**-1 s**-1 ]: +C U.S. Standard Atmosphere 1962 page 14 expression +C for dynamic viscosity is: +C dynamic viscosity = beta * T * sqrt(T) / ( T + S) +C where beta = 1.458e-6 [ kg sec^-1 K**-0.5 ], s = 110.4 [ K ]. + AMU = 1.458E-6 * AIRTEMP * SQRT_TEMP / ( AIRTEMP + 110.4 ) + +C *** Set minimums for coarse mode + MOMENT0_CONC( N_MODE ) = MAX( AEROMODE_MINNUM( N_MODE ), + & MOMENT0_CONC( N_MODE ) ) + +C *** Outside AEROPROC, the surface area concentration [ m**2 / m**3 ] +C of the Aitken and accumulation modes is tracked. Internally, +C the 2nd moment concentration is the variable of interest. +C Surface area = pi * 2nd moment. + DO N = 1, N_MODE + MOMENT2_CONC( N ) = MOMENT2_CONC( N ) / PI + END DO + +C *** Update the third moments, geometric mean diameters, geometric +C standard deviations, modal mass totals, and modal particle +C densities, based on the concentrations of M2, M0, and speciated +C masses resulting from transport, cloud processing, and gas-phase +C chemistry. Ignore H2O and semi-volatile SOA (i.e., M3_WET_FLAG +C = .FALSE.) because those species are not transported with the +C 2nd moment and their concentrations will be updated subsequently +C to establish gas/particle equilibrium. + M3_WET_FLAG = .FALSE. + LIMIT_Sg = .FALSE. + CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) + +C *** Secondary Organics +C Update the secondary organic aerosol (SOA) mass concentrations +C and the SVOC mass concentrations by equilibrium absorptive +C partitioning between the particle and vapor phases. Assume all +C SOA resides in the accumulation mode. + CALL ORGAER( DT, LAYER ) + +C *** POA Aging +C Increase primary NCOM concentration due to oxidative aging of POA. + CALL POAAGE ( DT ) + +C *** Heterogeneous Chemistry +C Update the N2O5 and HNO3 concentrations to account for +C heterogenous nitrate formation. + CALL HETCHEM ( GAMMA_N2O5, DT ) + +C *** Secondary Inorganics +C The VOLINORG subroutine includes the treatment of new particle +C production and a fully dynamic treatment of inorganic gas-to- +C particle mass transfer. + +C *** Compute H2SO4 diffusivity, correct for temperature and pressure + DIFFCORR = ( STDATMPA / AIRPRES ) * ( AIRTEMP / 273.16 ) ** 1.75 + DV_SO4 = DIFFSULF * DIFFCORR + +C *** Augment 2nd and 3rd moment concentrations with H2O and recompute +C size distribution parameters because wetted distribution is +C needed in subroutine VOLINORG + + DO N = 1, N_MODE + M3_OLD = MOMENT3_CONC( N ) + M2_OLD = MOMENT2_CONC( N ) + + MOMENT3_CONC( N ) = M3_OLD + H2OFAC * AEROSPC_CONC( AH2O_IDX, N ) + MOMENT2_CONC( N ) = M2_OLD * ( MOMENT3_CONC( N ) / M3_OLD ) ** TWOTHIRDS + END DO + + M3_WET_FLAG = .TRUE. + CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) + + CALL VOLINORG( DT, COL, ROW, LAYER, + & DV_SO4, CGR, M3_WET_FLAG ) + +C *** Coagulation +C Calculate coagulation coefficients using a method dictated by +C the value of FASTCOAG_FLAG. If TRUE, the computationally- +C efficient GETCOAGS routine is used. If FALSE, the more intensive +C Gauss-Hermite numerical quadrature method is used. See Section +C 2.1 of Bhave et al. (2004) for further discussion. + +C *** set atmospheric mean free path in double precision + LAMDA = XLM + +C *** calculate term used in Equation A6 of Binkowski & Shankar (1995) + KNC = TWOTHIRDS * BOLTZMANN * AIRTEMP / AMU + +C *** calculate terms used in Equation A5 of Binkowski & Shankar (1995) + KFMAT = SQRT( 3.0 * BOLTZMANN * AIRTEMP / AEROMODE_DENS( 1 ) ) + KFMAC = SQRT( 3.0 * BOLTZMANN * AIRTEMP / AEROMODE_DENS( 2 ) ) + KFMATAC = SQRT( 6.0 * BOLTZMANN * AIRTEMP + & / ( AEROMODE_DENS( 1 ) + AEROMODE_DENS( 2 ) ) ) + +C *** transfer of number to accumulation mode from Aitken mode is zero + BACAT( 1 ) = 0.0 + + IF ( FASTCOAG_FLAG ) THEN ! Solve coagulation analytically + +C *** set geometric mean diameters, geometric standard deviations, and +C ln(GSD) in double precision + DO N = 1, N_MODE + DG_D( N ) = AEROMODE_DIAM( N ) + SG_D( N ) = EXP( AEROMODE_SDEV( N ) ) + XXL_D( N ) = AEROMODE_SDEV( N ) + END DO + +C *** calculate intermodal and intramodal coagulation coefficients +C for zeroth and second moments, and intermodal coagulation +C coefficient for third moment + CALL GETCOAGS( LAMDA, KFMATAC, KFMAT, KFMAC, KNC, + & DG_D(1), DG_D(2), SG_D(1), SG_D(2), + & XXL_D(1),XXL_D(2), + & BATAT( 2 ), BATAT( 1 ), BACAC( 2 ), BACAC( 1 ), + & BATAC( 2 ), BACAT( 2 ), BATAC( 1 ), C3IJ ) + + ELSE ! Use Gauss-Hermite numerical quadrature + +C *** calculate Aitken-mode intramodal coagulation coefficients +C for zeroth and second moments + CALL INTRACOAG_GH( LAMDA, KFMAT, KNC, AEROMODE_DIAM( 1 ), + & AEROMODE_SDEV( 1 ), BATAT( 2 ), BATAT( 1 ) ) + +C *** calculate accumulation-mode intramodal coagulation coefficients +C for zeroth and second moments + CALL INTRACOAG_GH( LAMDA, KFMAC, KNC, AEROMODE_DIAM( 2 ), + & AEROMODE_SDEV( 2 ), BACAC( 2 ), BACAC( 1 ) ) + +C *** calculate intermodal coagulation coefficients for zeroth, second, +C and third moments + CALL INTERCOAG_GH( LAMDA, KFMATAC, KNC, + & AEROMODE_DIAM( 1 ), AEROMODE_DIAM( 2 ), + & AEROMODE_SDEV( 1 ), AEROMODE_SDEV( 2 ), + & BATAC( 2 ), BACAT( 2 ), BATAC( 1 ), C3IJ ) + + END IF ! FASTCOAG_FLAG + +C *** calculate 3rd moment intermodal transfer rate by coagulation + C30ATAC = C3IJ * MOMENT0_CONC( 1 ) * MOMENT0_CONC( 2 ) + +C *** TAKE ONE FORWARD TIME STEP - Solve Modal Dynamics Equations +C This code implements Section 1.4 of Binkowski and Roselle (2003) +C with two notable exceptions. 1) emissions are treated in +C CMAQ`s vertical diffusion routine, so they do not appear in the +C following equations. 2) new particle formation and condensational +C growth are now treated in the VOLINORG subroutine, so they do not +C appear in the following equations. + +C M2 is updated before M0 because the intermodal transfer rate of +C M2 is a function of the number concentrations. In contrast, +C production and loss rates of M0 are independent of M2. Advancing +C M2 before M0 avoids operator splitting within the modal-dynamic- +C equation solution. A similar rearrangement would be necessary +C for the M3 update, but the dependence of M3 on number +C concentrations already is accounted for in the C30ATAC term. + +C *** UPDATE SECOND MOMENT +C For each lognormal mode, solve equations of form: +C dM2/dt = P2 - L2*M2 ! if L2 > 0 +C with solution +C M2(t) = P2/L2 + ( M2(t0) - P2/L2 ) * exp( -L2*dt ) +C or +C dM2/dt = P2 ! if L2 = 0 +C with solution +C M2(t) = M2(t0) + P2*dt + +C *** Aitken mode: initial value of M2 + M20 = MOMENT2_CONC( 1 ) + +C *** Loss of 2nd moment from Aitken mode is due to intermodal +C coagulation with accumulation mode and intramodal coagulation. +C Production term is removed, because new particle formation +C and condensational growth are accounted for in VOLINORG. + LOSS = ( + & ( BATAT( 2 ) * MOMENT0_CONC( 1 ) + & + BATAC( 2 ) * MOMENT0_CONC( 2 ) ) * MOMENT0_CONC( 1 ) + & ) / M20 + +C *** Solve for M2_Aitken based on LOSS during this time step +C Note: LOSS is assumed to be non-negative. + IF ( LOSS .GT. 0.0 ) THEN + Y = M20 * EXP( -LOSS * DT ) + ELSE + Y = M20 + END IF ! test on loss + +C *** Transfer new value of M2_Aitken to the array + MOMENT2_CONC( 1 ) = MAX( REAL( AEROMODE_MINM2( 1 ) ), REAL( Y ) ) + +C *** Accumulation mode: initial value of M2 + M20 = MOMENT2_CONC( 2 ) + +C *** Production of 2nd moment in accumulation mode is due to +C intermodal coagulation Aitken mode + PROD = BACAT( 2 ) * MOMENT0_CONC( 1 ) * MOMENT0_CONC( 2 ) + +C *** Loss of 2nd moment from accumulation mode is due only to +C intramodal coagulation + LOSS = ( BACAC( 2 ) * MOMENT0_CONC( 2 ) * MOMENT0_CONC( 2 ) ) / M20 + +C *** Solve for M2_accum based on PROD and LOSS during this time step +C Note: LOSS is assumed to be non-negative. + IF ( LOSS .GT. 0.0 ) THEN + POL = PROD / LOSS + Y = POL + ( M20 - POL ) * EXP( -LOSS * DT ) + ELSE + Y = M20 + PROD * DT + END IF ! test on loss + +C *** Transfer new value of M2_accum to moment array + MOMENT2_CONC( 2 ) = MAX( REAL( AEROMODE_MINM2( 2 ) ), REAL( Y ) ) + +C *** Coarse mode: no change because coagulation of coarse particles +C is neglected in current model version. + +C *** end of update for second moment + +C *** Update Zeroth Moment (i.e. number concentration) + +C *** Aitken mode: initial value of M0 + + Y0 = MOMENT0_CONC( 1 ) + +C *** The rate of change for M0_Aitken is described in Equation 8a of +C Binkowski & Roselle (2003), with the c_i term equal to 0. + + A = BATAT( 1 ) ! intramodal coagulation + B = BATAC( 1 ) * moment0_conc( 2 ) ! intermodal coagulation + + EXPDT = EXP( - B * DT ) + IF ( EXPDT .LT. 1.0D0 ) THEN + Y = B * Y0 * EXPDT / ( B + A * Y0 * ( 1.0D0 - EXPDT ) ) + ELSE + Y = Y0 ! solution in the limit that B approaches zero + END IF + +C *** Transfer new value of M0_Aitken to the moment array + MOMENT0_CONC( 1 ) = MAX( AEROMODE_MINNUM( 1 ), REAL( Y ) ) + +C *** Accumulation mode: initial value of M0 + Y0 = MOMENT0_CONC( 2 ) + +C *** The rate of change for M0_accum is described in Equation 8b of +C Binkowski & Roselle (2003), except the coefficient C is zero +C because emissions are treated outside the CMAQ aerosol module. +C The equation reduces to the form: dY/dt = -A * Y**2 , where + A = BACAC( 1 ) ! intramodal coagulation + +C *** Solve for M0_accum using Smoluchowski`s solution + Y = Y0 / ( 1.0D0 + A * Y0 * DT ) + +C *** Transfer new value of M0_accum to the moment array + MOMENT0_CONC( 2 ) = MAX( AEROMODE_MINNUM( 2 ), REAL( Y ) ) + +C *** end of update for zeroth moment - note that the coarse mode number does +C not change because coarse-mode coagulation is neglected in the model + +C *** UPDATE MASS CONCENTRATIONS (for each species) +C The following procedure is described in Paragraphs 21-23 +C of Binkowski & Roselle (2003), except the Ei,n and Ej,n terms +C are excluded here because emissions are treated outside the +C CMAQ aerosol module. + +C Aitken mode mass concentration rates of change are of the form: +C dc/dt = P - L*c ! Equation 9a of Binkowski & Roselle (2003) +C with solution +C c(t0 + dt) = P/L + ( c(t0) - P/L ) * exp(-L*dt) + +C For all species, loss of Aitken mode mass is due to intermodal +C coagulation. +C LOSSn = PI/6 * RHOn * C30ATAC / MASSn +C RHOn = MASSn / (M3 * PI/6) +C When above equations are combined, the PI/6 terms cancel yielding +C LOSSn = C30ATAC / M3 +C where LOSSn is the loss rate of species n, RHOn is the mass of +C species n per unit of particle volume, C30ATAC is the 3rd moment +C loss rate due to intermodal coagulation, MASSn is the mass +C concentration of species n, and M3 is the 3rd moment +C concentration. + + LOSS = C30ATAC / MOMENT3_CONC( 1 ) + +C *** Set up extra variables to solve for Aitken mode mass concentrations + FACTRANS = LOSS * DT + EXPDT = EXP( -FACTRANS ) + LOSSINV = 1.0 / LOSS + +C *** Secondary Organics and Inorganics +C These species are produced by condensation, but their mass +C concentrations have been updated in subroutine VOLINORG. Therefore, +C only the mass transfer due to intermodal coagulation is +C treated here. + + DO SPC = 1, N_AEROSPC + IF ( SPC .EQ. ANA_IDX ) CYCLE + IF ( AEROSPC( SPC )%NAME( 1 ) .EQ. ' ' ) CYCLE + + TMASS = AEROSPC_CONC( SPC,1 ) + AEROSPC_CONC( SPC,2 ) + AEROSPC_CONC( SPC,1 ) = MAX( AEROSPC( SPC )%MIN_CONC( 1 ), + & REAL( AEROSPC_CONC( SPC,1 ) * EXPDT ) ) + AEROSPC_CONC( SPC,2 ) = MAX( AEROSPC( SPC )%MIN_CONC( 2 ), + & TMASS - AEROSPC_CONC( SPC,1 ) ) + END DO + +C *** end of update for species mass concentrations + +C *** Mode Merging +C This code implements Section 1.5 of Binkowski and Roselle (2003). +C If the Aitken mode mass is growing faster than accumulation mode +C mass and the Aitken mode number concentration exceeds the +C accumulation mode number concentration, then modes are merged by +C renaming. + +#ifdef nomm + if ( .false. ) then +#else + IF ( CGR( 1 ) .GT. CGR( 2 ) .AND. + & MOMENT0_CONC( 1 ) .GT. MOMENT0_CONC( 2 ) ) THEN +#endif + +C *** Before mode merging, update the third moments, geometric mean +C diameters, geometric standard deviations, modal mass totals, and +C particle densities, based on the new concentrations of M2, M0, and +C speciated masses calculated above. + CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) + +C *** Calculate AAA = ln( Dij / DGATK ) / ( SQRT2 * XXLSGAT ), where Dij +C is the diameter at which the Aitken-mode and accumulation-mode +C number distributions intersect (i.e., overlap). AAA is equivalent +C to the "Xnum" term described below Equation 10a by Binkowski and +C Roselle (2003). + AAA = GETAF( MOMENT0_CONC( 1 ), MOMENT0_CONC( 2 ), + & AEROMODE_DIAM( 1 ), AEROMODE_DIAM( 2 ), + & AEROMODE_SDEV( 1 ), AEROMODE_SDEV( 2 ), + & SQRT2 ) + +C *** Ensure that Xnum is large enough so that no more than half of +C the Aitken mode mass is merged into the accumulation mode during +C any given time step. This criterion is described in Paragraph 26 +C of Binkowski and Roselle (2003). + XXM3 = 3.0 * AEROMODE_SDEV( 1 ) / SQRT2 + XNUM = MAX( AAA, XXM3 ) + +C *** Factors used in error function calls for M2 and M3 mode merging + XXM2 = TWOTHIRDS * XXM3 + XM2 = XNUM - XXM2 ! set up for 2nd moment transfer + XM3 = XNUM - XXM3 ! set up for 3rd moment and mass transfers + +C *** Calculate the fractions of the number, 2nd, and 3rd moment +C distributions with diameter greater than the intersection diameter + FNUM = 0.5 * ERFC( XNUM ) ! Eq 10a of B&R 2003 + FM2 = 0.5 * ERFC( XM2 ) ! Eq 10b of B&R 2003 + FM3 = 0.5 * ERFC( XM3 ) ! Eq 10b of B&R 2003 + +C *** Calculate the fractions of the number, 2nd, and 3rd moment +C distributions with diameters less than the intersection diameter. + PHNUM = 0.5 * ( 1.0 + ERF( XNUM ) ) ! Eq 10c of B&R 2003 + PHM2 = 0.5 * ( 1.0 + ERF( XM2 ) ) ! Eq 10d of B&R 2003 + PHM3 = 0.5 * ( 1.0 + ERF( XM3 ) ) ! Eq 10d of B&R 2003 + +C *** Update accumulation-mode moment concentrations using +C Equations 11a - 11c of Binkowski and Roselle (2003). + MOMENT0_CONC( 2 ) = MOMENT0_CONC( 2 ) + MOMENT0_CONC( 1 ) * FNUM + MOMENT2_CONC( 2 ) = MOMENT2_CONC( 2 ) + MOMENT2_CONC( 1 ) * FM2 + MOMENT3_CONC( 2 ) = MOMENT3_CONC( 2 ) + MOMENT3_CONC( 1 ) * FM3 + +C *** Update Aitken-mode moment concentrations using +C Equations 11d - 11f of Binkowski and Roselle (2003). + MOMENT0_CONC( 1 ) = MOMENT0_CONC( 1 ) * PHNUM + MOMENT2_CONC( 1 ) = MOMENT2_CONC( 1 ) * PHM2 + MOMENT3_CONC( 1 ) = MOMENT3_CONC( 1 ) * PHM3 + +C *** Rename masses of each species from Aitken mode to acumulation mode +C using Equation 11b of Binkowski and Roselle (2003). + DO SPC = 1, N_AEROSPC + IF ( SPC .EQ. ANA_IDX ) CYCLE + IF ( SPC .EQ. ACL_IDX ) CYCLE + IF ( AEROSPC( SPC )%NAME( 1 ) .EQ. ' ' ) CYCLE + + AEROSPC_CONC( SPC,2 ) = AEROSPC_CONC( SPC,2 ) + AEROSPC_CONC( SPC,1 ) * FM3 + AEROSPC_CONC( SPC,1 ) = AEROSPC_CONC( SPC,1 ) * PHM3 + END DO + + END IF ! end check on necessity for merging + +C *** end of update for mode merging + +C *** Update the third moments, geometric mean diameters, geometric +C standard deviations, modal mass totals, and particle densities, +C based on the final concentrations of M2, M0, and speciated masses +C after mode merging is complete. + CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) + +C *** Set minimum value for all concentrations in the CBLK array + + DO N = 1, N_MODE + DO SPC = 1, N_AEROSPC + AEROSPC_CONC( SPC,N ) = MAX( AEROSPC_CONC( SPC,N ), + & AEROSPC( SPC )%MIN_CONC( N ) ) + END DO + END DO + + RETURN + END SUBROUTINE AEROPROC + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE VOLINORG( DT, COL, ROW, LAYER, + & DV_SO4, CGR, M3_WET_FLAG ) + +C *** Calculates the partitioning of inorganic components (CL,NO3,NH4,SO4) +C between the aerosol and gas phase over the operator synchronization +C timestep (DT). Partitioning is calculated using the Hybrid approach, +C where dynamic mass transfer of species to/from the coarse mode is +C calculated using multiple sub-operator time steps (TSTEP) and the +C fine modes are equilibrated with the gas phase. The mass transfer +C calculations are made using the H+ flux-limiting approach of Pilinis +C et al. (2000). If 'OPTIONFLAG' is not set to 'Hybrid', the mass +C transfer calculations for the coarse mode are skipped, and the fine +C modes are equilibrated with the gas phase. + +C Returns updated volatile inorganic species concentrations in the gas +C and particulate phase, and the aerosol modal parameters + +C *** Revision history: 4/07 - Moved HCOND3 and NEWPART3 calls from +C AEROPROC to this subroutine for +C mass transfer calculation +C 15 Jul 08, J.Young, P.Bhave: increased cutoff to hybrid from .01 to .05 ug/m**3 +C J.Young: change 'OPTIONFLAG' to just a logical variable, 'Hybrid' +C +C SH 03/10/11 Renamed met_data to aeromet_data +C SR 03/25/11 Replaced I/O API include files with UTILIO_DEFN + +C *** References +C 1. Pilinis C, Capaldo KP, Nenes A, Pandis SN (2000) MADM - A new +C multicomponent aerosol dynamics model. AEROSOL SCIENCE AND TECHNOLOGY. +C 32(5):482-502 +C +C 2. Capaldo KP, Pilinis C, Pandis SN (2000) A computationally efficient hybrid +C approach for dynamic gas/aerosol transfer in air quality models. ATMOSPHERIC +C ENVIRONMENT. 34(21):3617-3627 + + USE AERO_DATA + USE PRECURSOR_DATA + USE SOA_DEFN + USE AEROMET_DATA + USE UTILIO_DEFN + + IMPLICIT NONE + +C *** Arguments: + REAL DT ! time step [sec] + INTEGER COL ! grid column index + INTEGER ROW ! grid row index + INTEGER LAYER ! model layer index + REAL DV_SO4 ! molecular diffusivity of H2SO4 vapor + ! after correction for ambient conditions + REAL( 8 ) :: CGR( N_MODE-1 ) ! 3rd moment SO4 growth rate [m^3/m^3-s] + LOGICAL M3_WET_FLAG ! flag to include water in GETPAR update + +C *** Parameters: + INTEGER, PARAMETER :: NINORG = 6 ! number of inorganic species + INTEGER, PARAMETER :: NVOLINORG = 3 ! number of volatile inorganic species + + ! indices for inorganic species + INTEGER, PARAMETER :: KNH4 = 1, KNO3 = 2, KCL = 3, KSO4 = 4, KNA = 5, KHP = 6 + + REAL( 8 ), PARAMETER :: D_TWOTHIRDS = 2.0D0 / 3.0D0 + + REAL, PARAMETER :: CUTOFF = 0.05 ! [ug/m**3] + REAL, PARAMETER :: ALPHSULF = 0.1 ! Accommodation coefficient for sulfuric acid + ! see Capaldo et al. (2000) + +C *** Local Variables: + +C *** Inputs to subroutine HCOND3 + + REAL, SAVE :: COFCBAR_SO4 ! Temperature-independent coefficients + ! for caculating molecular vel [m/s] + ! = sqrt((8*Rgas)/(pi*MW)) + REAL CBAR_SO4 ! molecular velocity of H2SO4 + + REAL( 8 ) :: AM0( N_MODE ) ! zeroth moments + REAL( 8 ) :: AM1( N_MODE ) ! first moments + REAL( 8 ) :: AM2( N_MODE ) ! second moments + +C *** Outputs from HCOND3: size-dependent term in the condensational-growth +C expressions defined in Equations A13-A14 of [Binkowski & Shankar,1995] + REAL( 8 ) :: FCONC_SO4( N_MODE,2 ) ! All sizes 2nd and 3rd moments + REAL( 8 ) :: FCONCM1_SO4 ! reciprocals of total SO4 cond rates + +C *** Modal partition factors [ dimensionless ] +C defined in Equations A17-A18 of [Binkowski & Shankar,1995] + REAL( 8 ) :: OMEGA_AT_SO4 ! Aitken mode 2nd and 3rd moments + REAL( 8 ) :: OMEGA_AC_SO4 ! Accumulation mode 2nd and 3rd moments + REAL( 8 ) :: OMEGA( 2 ) ! partitioning coefficient for equilibrium PM mass + +C *** Variables for new particle formation: + REAL XH2SO4 ! steady state H2SO4 concentration + REAL( 8 ) :: DMDT_SO4 ! particle mass production rate [ ug/m**3 s ] + REAL( 8 ) :: DNDT ! particle number production rate [ # / m**3 s ] + REAL( 8 ) :: DM2DT ! second moment production rate [ m**2 / m**3 s] + REAL( 8 ) :: SCONDRATE ! SO4 condensation rate [ ug/m**3 s ] + +C *** Mode-specific sulfate production rate [ ug/m**3 s ] + REAL( 8 ) :: CONDSO4( N_MODE ) ! sulfate condensation rate [ ug/m**3 s ] + REAL( 8 ) :: RATE ! CONDSO4 or cond+nucl rate + +C *** Size-dependent portion of mass-transfer rate equation + REAL( 8 ) :: GRFAC1( N_MODE ) ! 2nd moment [ m**2/m**3-s ] + REAL( 8 ) :: GRFAC2( N_MODE ) ! 3rd moment [ m**3/m**3-s ] + +C *** ISORROPIA input variables + REAL( 8 ) :: WI( NINORG - 1 ) ! species array + REAL( 8 ) :: RHI ! relative humidity + REAL( 8 ) :: TEMPI ! temperature + REAL( 8 ) :: CNTRL( 2 ) ! control parameters + +C *** ISORROPIA output variables + REAL( 8 ) :: WT( NINORG - 1 ) ! species output array + REAL( 8 ) :: GAS( 3 ) ! gas-phase " " + REAL( 8 ) :: AERLIQ( 12 ) ! liq aerosol " " + REAL( 8 ) :: AERSLD( 9 ) ! solid " " " + REAL( 8 ) :: OTHER( 6 ) ! supplmentary output array + CHARACTER( 15 ) :: SCASI ! subcase number output + +C *** Variables to account for mass conservation violations in ISRP3F + LOGICAL TRUSTNH4 ! false if ISOROPIA's partitioning + ! of NH4/NH3 is to be ignored + LOGICAL TRUSTCL ! false if ISOROPIA's partitioning + ! of Cl/HCl is to be ignored + +C *** Initial (double-precision) concentrations [ug/m3] + REAL( 8 ) :: GNH3R8 ! gas-phase ammonia + REAL( 8 ) :: GNO3R8 ! gas-phase nitric acid + REAL( 8 ) :: GCLR8 ! gas-phase hydrochloric acid + REAL( 8 ) :: H2OR8 ! aerosol LWC + +C *** Variables for volatile species mass transfer between gas and aerosol and +C mass partitioning between the modes + LOGICAL HYBRID ! mass transfer option flag (mass transfer if .TRUE.) + REAL( 8 ) :: DELT ! time step DT [s] + REAL( 8 ) :: HPLUS( N_MODE ) ! scratch var for H+ [umol/m**3] + + REAL( 8 ), SAVE :: H2SO4RATM1 ! Mol. wt. ratio of SO4/H2SO4 + + REAL( 8 ) :: JH2SO4 ! flux of cond./evap. H2SO4 (mol/m3/s) + REAL( 8 ) :: CH2SO4 ! concentration of H2SO4 before cond/evap (mol/m3) + REAL( 8 ) :: DVOLINORG( NVOLINORG ) ! vol inorg spcs mass to be xferred [mol/m3] + REAL( 8 ) :: DVOLMAX ! max value for DVOLINORG + REAL( 8 ) :: CINORG( NINORG,N_MODE ) ! scratch array for inorg spcs [ug/m**3] + REAL( 8 ) :: INT_TIME ! internal mass transfer time (s) + REAL( 8 ) :: TSTEP ! mass transfer time step [s] + REAL( 8 ) :: DRYM20, Y ! scratch vars for 2nd moment [m**2/m**3] + REAL( 8 ) :: M3OTHR, M3SOA ! vars for 3rd moment calculation [m**3/m**3] + REAL( 8 ), SAVE :: DF( NVOLINORG ) ! scratch array for mole -> ug conversion + REAL( 8 ), SAVE :: DFH2OR8 ! mole -> ug conversion for H2O + REAL( 8 ) :: CONVFAC ! conversion factor for SO4 conc from DH2SO4/DT + REAL( 8 ) :: J( NVOLINORG ) ! condensation/evaporation flux [mol/m**3-s] + REAL( 8 ) :: CFINAL( NVOLINORG,N_MODE ) ! conc after mass xfer step [ug/m**3] + REAL( 8 ) :: H2O ! Scratch LWC variable for output + REAL( 8 ) :: H2O_NEW ! Update of LWC after condensation + REAL( 8 ) :: SO4 ! modal SO4 after condensation or cond + nucl + REAL( 8 ) :: DMASS( NVOLINORG ) ! excess mass in fine mode partitioning + REAL( 8 ) :: DDRYM3DT ! rate of 3rd moment transfer - dry inorg spcs + REAL( 8 ) :: DDRYM2DT ! rate of 2nd moment transfer - " " " + REAL( 8 ) :: DRYM3, WETM3 ! scratch vars for 3rd moment calc [m**3/m**3] + REAL( 8 ) :: DRYM2, WETM2 ! scratch vars for 2nd moment calc [m**2/m**3] + REAL( 8 ) :: LOSS ! rate of loss of second moment [1/s] + + REAL( 8 ) :: TMP + INTEGER I, N ! loop and array indices + INTEGER IMODE ! mode loop index + INTEGER ISTEP ! loop index, mass transfer time step loop + INTEGER ISP ! loop index, species loop + INTEGER, SAVE :: LOGDEV + LOGICAL, PARAMETER :: LIMIT_Sg = .TRUE. ! fix Sg at current value? + LOGICAL TrustIso ! For negative vap. press., TrustIso = F + +C *** Local Saved Variables + LOGICAL, SAVE :: FIRSTIME = .TRUE. + LOGICAL, SAVE :: FIRSTWRITE = .TRUE. + REAL( 8 ), SAVE :: SO4FAC ! F6DPIM9 / RHOSO4 + REAL( 8 ), SAVE :: SOILFAC ! F6DPIM9 / RHOSOIL + REAL( 8 ), SAVE :: ANTHFAC ! F6DPIM9 / RHOANTH + REAL( 8 ), SAVE :: NH3RAT ! Mol. wt ratios NH3/NH4 + REAL( 8 ), SAVE :: HNO3RAT ! Mol. wt ratios HNO3/NO3 + REAL( 8 ), SAVE :: HCLRAT ! Mol. wt ratios HCL/CL + REAL( 8 ), SAVE :: MWH2SO4 ! molecular weight for H2SO4 + REAL( 8 ), SAVE :: FAERH2SO4 ! 1e-6 / mw(h2so4) + + +C----------------------------------------------------------------------- + + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. + LOGDEV = INIT3() +#ifdef noiso + write( logdev,* ) 'aero_subs, volinorg: noiso' +#endif + + MWH2SO4 = PRECURSOR_MW( SULF_IDX ) ! molecular weight for H2SO4 + FAERH2SO4 = 1.0E-6 / MWH2SO4 + + COFCBAR_SO4 = SQRT( 8.0 * RGASUNIV / ( PI * MWH2SO4 * 1.0E-3 ) ) + H2SO4RATM1 = AEROSPC_MW( ASO4_IDX ) / MWH2SO4 + SO4FAC = 1.0E-9 * F6DPI / AEROSPC( ASO4_IDX )%DENSITY + SOILFAC = 1.0E-9 * F6DPI / AEROSPC( ASOIL_IDX )%DENSITY + ANTHFAC = 1.0E-9 * F6DPI / AEROSPC( ACORS_IDX )%DENSITY + + DF( KNH4 ) = 1.0D6 * AEROSPC_MW( ANH4_IDX ) + DF( KNO3 ) = 1.0D6 * AEROSPC_MW( ANO3_IDX ) + DF( KCL ) = 1.0D6 * AEROSPC_MW( ACL_IDX ) + DFH2OR8 = 1.0D6 * MWWAT ! aerospc_mw(AH2O_IDX) (18.0 != 18.0153) + + ! Mol. wt ratios NH3/NH4, HNO3/NO3, HCL/CL + NH3RAT = PRECURSOR_MW( NH3_IDX ) / AEROSPC_MW( ANH4_IDX ) + HNO3RAT = PRECURSOR_MW( HNO3_IDX ) / AEROSPC_MW( ANO3_IDX ) + HCLRAT = PRECURSOR_MW( HCL_IDX ) / AEROSPC_MW( ACL_IDX ) + END IF + +C *** Determine if Hybrid + TMP = 0.0 +#ifdef noiso + hybrid = .false. +#else + DO I = 1, N_AEROSPC + IF ( AEROSPC( I )%CHARGE .NE. 0 ) TMP = TMP + AEROSPC_CONC( I,N_MODE ) + END DO + HYBRID = ( TMP .GE. CUTOFF ) .AND. ( AIRRH .GE. 0.18 ) +#endif + + DELT = REAL( DT, 8 ) + CONVFAC = DELT * H2SO4RATM1 + + TEMPI = AIRTEMP ! assume const within synch timestep + RHI = MIN( 0.95, AIRRH ) ! " " " " " + +C *** Calculate molecular velocities (temperature dependent) and +C H+ concentration + + CBAR_SO4 = COFCBAR_SO4 * SQRT( AIRTEMP ) + + HPLUS = 0.0 + DO I = 1, N_MODE + DO N = 1, N_AEROSPC + HPLUS( I ) = HPLUS( I ) + & - AEROSPC( N )%CHARGE * AEROSPC_CONC( N,I ) / AEROSPC_MW( N ) + END DO + END DO + +C *** Condensational Growth (Size-dependent terms) +C Calculate intermediate variables needed to determine the 2nd and +C 3rd moment condensational-growth rates. 3rd moment terms are +C needed for the calculation of new particle production. See +C Section 3.3 of Jiang & Roth (2003) for a detailed discussion. +C +C *** Calculate first moments using Equation 4 of Binkowski & Shankar +C (1995) or Equation 3 of Binkowski and Roselle (2003). +C N.B: these are for a "wet" size distribution + + DO I = 1, N_MODE + AM0( I ) = MOMENT0_CONC( I ) + AM1( I ) = MOMENT0_CONC( I ) * AEROMODE_DIAM( I ) + & * EXP( 0.5 * AEROMODE_SDEV( I ) * AEROMODE_SDEV( I ) ) + AM2( I ) = MOMENT2_CONC( I ) + END DO + +C *** Calculate the size-dependent terms in the condensational- +C growth factor expressions for sulfate using +C Equations A13-A14 of Binkowski & Shankar (1995). + + DO I = 1, N_MODE + CALL HCOND3( AM0( I ), AM1( I ), AM2( I ), + & DV_SO4, ALPHSULF, CBAR_SO4, FCONC_SO4( I,: ) ) + END DO + + IF ( .NOT. HYBRID ) THEN + FCONC_SO4( N_MODE,1 ) = 0.D0 + FCONC_SO4( N_MODE,2 ) = 0.D0 + END IF + + DO I = 1, N_MODE + GRFAC1( I ) = FCONC_SO4( I,1 ) + GRFAC2( I ) = FCONC_SO4( I,2 ) + END DO + +C *** New Particle Production +C Calculate the new particle production rate due to binary +C nucleation of H2O and H2SO4. These calculations are performed +C only when the gas-phase production rate of H2SO4 (i.e., SO4RATE) +C is non-zero. The condensation rate of H2SO4 is calculated as the +C gas-phase production rate minus the new particle production rate. + +C *** Initialize Variables + DMDT_SO4 = 0.0D0 + DNDT = 0.0D0 + DM2DT = 0.0D0 + SCONDRATE = 0.0D0 + +C *** Produce new particles only during time steps when the gas-phase +C production rate of H2SO4 is non-zero + + IF ( SO4RATE .NE. 0.0D0 ) THEN + +C *** Adjust sulfuric acid vapor concentration to a value in +C equilibrium with the production of new particles and the +C condensation of sulfuric acid vapor on existing particles, based +C on Equations A21 and A23 of Binkowski & Shankar (1995). + TMP = 0.0 + DO I = 1, N_MODE + TMP = TMP + FCONC_SO4( I,2 ) + END DO + + XH2SO4 = SO4RATE / TMP + XH2SO4 = MAX( XH2SO4, CONMIN ) + PRECURSOR_CONC( SULF_IDX ) = XH2SO4 + +C *** Calculate new particle production rate for 0th, 2nd, & 3rd moments + CALL NEWPART3 ( AIRRH, AIRTEMP, XH2SO4, SO4RATE, + & DNDT, DMDT_SO4, DM2DT ) + +C *** Calculate sulfate condensation rate as the gas-phase production +C rate minus the new particle production rate, following Equation +C 3.23 of Jiang & Roth (2003). + SCONDRATE = MAX( SO4RATE - DMDT_SO4, 0.0D0 ) + + END IF ! SO4RATE .NE. 0 + +C *** Sulfate Condensation (Size-resolved) +C Calculate rate at which condensing sulfate should be added to each +C mode. The "omega" factors are defined in Equations 7a and 7b of +C Binkowski & Shankar (1995). The i-mode and j-mode factors are +C calculated using Equation A17 of Binkowski & Shankar (1995). The +C condensation rate for accumulation mode (fine-equilibrium scheme) or +C coarse mode (hybrid and dynamic schemes) is computed by difference, +C to avoid mass conservation violations arising from numerical error. + TMP = 0.0 + DO I = 1, N_MODE + TMP = TMP + FCONC_SO4( I,2 ) + END DO + + FCONCM1_SO4 = 1.0D0 / TMP + OMEGA_AT_SO4 = FCONCM1_SO4 * FCONC_SO4( 1,2 ) + OMEGA_AC_SO4 = FCONCM1_SO4 * FCONC_SO4( 2,2 ) + +C *** Growth values for mode merge condition + CGR( 1 ) = SO4FAC * SCONDRATE * OMEGA_AT_SO4 + CGR( 2 ) = SO4FAC * SCONDRATE * OMEGA_AC_SO4 + + CONDSO4( 1 ) = OMEGA_AT_SO4 * SCONDRATE + + IF ( HYBRID ) THEN + CONDSO4( 2 ) = OMEGA_AC_SO4 * SCONDRATE + CONDSO4( 3 ) = SCONDRATE - ( CONDSO4( 1 ) + CONDSO4( 2 ) ) + ELSE ! fine equilibrium + CONDSO4( 2 ) = SCONDRATE - CONDSO4( 1 ) + CONDSO4( 3 ) = 0.0D0 ! no coarse mode chemistry + END IF + +C *** For Hybrid approach, calculate dynamic mass trasfer for +C semi-volatile components of coarse mode (NO3, CL, NH4) + + IF ( HYBRID ) THEN + + INT_TIME = 0.0D0 + TSTEP = 90.0D0 + ISTEP = 1 + IMODE = 3 + TrustIso = .TRUE. + + DO WHILE ( INT_TIME .LT. DELT ) + + IF ( INT_TIME + TSTEP .GT. DELT ) TSTEP = DELT - INT_TIME + INT_TIME = INT_TIME + TSTEP + ISTEP = ISTEP + 1 + + IF ( ISTEP .GT. 1 ) THEN + +C *** Calculate first moments using Equation 4 of Binkowski & Shankar +C (1995) or Equation 3 of Binkowski and Roselle (2003). +C N.B: these are for a "wet" size distribution + AM0( 3 ) = MOMENT0_CONC( 3 ) + AM1( 3 ) = MOMENT0_CONC( 3 ) * AEROMODE_DIAM( 3 ) + & * EXP( 0.5 * AEROMODE_SDEV( 3 ) * AEROMODE_SDEV( 3 ) ) + AM2( 3 ) = MOMENT2_CONC( 3 ) + +C *** Calculate the size-dependent terms in the condensational- +C growth factor expressions for sulfate using +C Equations A13-A14 of Binkowski & Shankar (1995). + CALL HCOND3( AM0( 3 ), AM1( 3 ), AM2( 3 ), DV_SO4, ALPHSULF, + & CBAR_SO4, FCONC_SO4( 3,: ) ) ! adapted from Eq A14 + + GRFAC1( 3 ) = FCONC_SO4( 3,1 ) + GRFAC2( 3 ) = FCONC_SO4( 3,2 ) + + END IF ! if ISTEP .GT. 1 + +C *** Set conc array to aerosol concentrations prior to mass transfer + CINORG( KNH4,IMODE ) = REAL( AEROSPC_CONC( ANH4_IDX,IMODE ), 8 ) + CINORG( KNO3,IMODE ) = REAL( AEROSPC_CONC( ANO3_IDX,IMODE ), 8 ) + CINORG( KCL, IMODE ) = REAL( AEROSPC_CONC( ACL_IDX,IMODE ), 8 ) + CINORG( KSO4,IMODE ) = REAL( AEROSPC_CONC( ASO4_IDX,IMODE ), 8 ) + CINORG( KNA, IMODE ) = REAL( AEROSPC_CONC( ANA_IDX,IMODE ), 8 ) + CINORG( KHP, IMODE ) = REAL( HPLUS( IMODE ), 8 ) + + M3OTHR = SOILFAC * AEROSPC_CONC( ASOIL_IDX,IMODE ) + & + ANTHFAC * AEROSPC_CONC( ACORS_IDX,IMODE ) + M3SOA = 0.0D0 + WETM3 = MOMENT3_CONC( IMODE ) + WETM2 = MOMENT2_CONC( IMODE ) + DRYM3 = WETM3 - REAL( H2OFAC * AEROSPC_CONC( AH2O_IDX, IMODE ), 8 ) + DRYM20 = WETM2 * ( DRYM3 / WETM3 ) ** D_TWOTHIRDS + +C *** Initial vapor-phase concentrations [ug/m3] + GNO3R8 = REAL( PRECURSOR_CONC( HNO3_IDX ), 8 ) + GNH3R8 = REAL( PRECURSOR_CONC( NH3_IDX ), 8 ) + GCLR8 = REAL( PRECURSOR_CONC( HCL_IDX ), 8 ) + +C *** This section of code calculates the distribution of ammonia/ +C ammonium, nitric acid/nitrate, and water between the gas and +C aerosol phases as a function of total sulfate, total ammonia, +C total nitrate, relative humidity, and temperature. It is assumed +C that the aerosol is entirely aqueous (i.e., metastable assumption), +C irrespective of ambient relative humidity. + +C *** Compute sulfate production rate [ug/m3 s] for coarse mode + + RATE = CONDSO4( IMODE ) + SO4 = CINORG( KSO4,IMODE ) + RATE * TSTEP * H2SO4RATM1 + + IF ( TrustIso ) THEN + +C *** Double Precision vars for ISORROPIA [mole/m3] + WI( 1 ) = CINORG( KNA, IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANA_IDX ), 8 ) + WI( 2 ) = SO4 * 1.0D-6 / REAL( AEROSPC_MW( ASO4_IDX ), 8 ) + WI( 3 ) = CINORG( KNH4,IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANH4_IDX ), 8 ) + WI( 4 ) = CINORG( KNO3,IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANO3_IDX ), 8 ) + WI( 5 ) = CINORG( KCL, IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ACL_IDX ), 8 ) + + CNTRL( 1 ) = 1.0D0 ! reverse problem + CNTRL( 2 ) = 1.0D0 ! aerosol in metastable state + +C *** Set flags to account for mass conservation violations in ISRP3F + TRUSTCL = .TRUE. + TRUSTNH4 = .TRUE. + IF ( WI( 1 ) + WI( 5 ) .LT. 1.0D-20 ) THEN + TRUSTCL = .FALSE. + ELSE + IF ( WI( 3 ) .LT. 1.0D-10 ) TRUSTNH4 = .FALSE. + IF ( WI( 5 ) .LT. 1.0D-10 ) TRUSTCL = .FALSE. + END IF + +C WI( 1 ) = NA [mol/m3] +C WI( 2 ) = SO4 " +C WI( 3 ) = NH4 " +C WI( 4 ) = NO3 " +C WI( 5 ) = CL " +C GAS(1) = NH3, GAS(2) = HNO3, GAS(3) = HCl + + CALL ISOROPIA( WI, RHI, TEMPI, CNTRL, WT, GAS, AERLIQ, + & AERSLD, SCASI, OTHER ) + + IF ( GAS( 1 ) .LT. 0.0D0 .OR. GAS( 2 ) .LT. 0.0D0 .OR. + & GAS( 3 ) .LT. 0.0D0 ) THEN + IF ( FIRSTWRITE ) THEN + FIRSTWRITE = .FALSE. + WRITE( LOGDEV,2023 ) + END IF + WRITE( LOGDEV,2029 ) COL, ROW, LAYER, GAS( 1 ), GAS( 2 ), GAS( 3 ) + TrustIso = .FALSE. + END IF + + END IF ! TrustIso + +C *** Change in volatile inorganic PM concentration to achieve +C equilibrium, calculated as initial-gas-phase concentration minus +C equilibrium gas-phase concentration. DVOLINORG is positive for +C condensation and negative for evaporation. + DVOLINORG( KNH4 ) = GNH3R8 * 1.0D-6 / REAL( PRECURSOR_MW( NH3_IDX ), 8 ) - GAS( 1 ) + DVOLINORG( KNO3 ) = GNO3R8 * 1.0D-6 / REAL( PRECURSOR_MW( HNO3_IDX ), 8 ) - GAS( 2 ) + DVOLINORG( KCL ) = GCLR8 * 1.0D-6 / REAL( PRECURSOR_MW( HCL_IDX ), 8 ) - GAS( 3 ) + +C *** Calculate condensation/evaporation flux for this time step and update +C volatile species concentrations. final aerosol conc set to be +C no less than the minimum aerosol conc + IF ( TrustIso ) THEN + CALL COMPUTE_FLUX( NVOLINORG, GNH3R8, GNO3R8, GCLR8, KNH4, + & KNO3, KCL, GAS( 1:3 ), GRFAC2( IMODE ), + & AERLIQ( 1 ), RATE, J ) + ELSE + J( : ) = 0.0D0 + END IF + + IF ( J( KNH4 ) * TSTEP * DF( KNH4 ) * NH3RAT .GT. GNH3R8 ) THEN + WRITE( LOGDEV,* ) 'Condensed amt. exceeds NH3 conc: aero_subs.f' + J( KNH4 ) = GNH3R8 / ( TSTEP * DF( KNH4 ) * NH3RAT ) + END IF + IF ( J( KNO3 ) * TSTEP * DF( KNO3 ) * HNO3RAT .GT. GNO3R8 ) THEN + WRITE( LOGDEV,* ) 'Condensed amt. exceeds HNO3 conc: aero_subs.f' + J( KNO3 ) = GNO3R8 / ( TSTEP * DF( KNO3 ) * HNO3RAT ) + END IF + IF ( J( KCL ) * TSTEP * DF(KCL) * HCLRAT .GT. GCLR8 ) THEN + WRITE( LOGDEV,* ) 'Condensed amt. exceeds HCl conc: aero_subs.f' + J( KCL ) = GCLR8 / ( TSTEP * DF( KCL ) * HCLRAT ) + END IF + +C *** Integrate mass transfer equation, convert flux from molar to mass + + DO ISP = 1, NVOLINORG + CFINAL( ISP,IMODE ) = MAX( 0.0D0, + & CINORG( ISP,IMODE ) + & + J( ISP ) * TSTEP * DF( ISP ) ) + END DO + +C *** Calculate updated H+ concentration + + HPLUS( IMODE ) = 2.0D0 * SO4 / AEROSPC_MW( ASO4_IDX ) + & + CFINAL( KNO3,IMODE ) / AEROSPC_MW( ANO3_IDX ) + & + CFINAL( KCL, IMODE ) / AEROSPC_MW( ACL_IDX ) + & - CFINAL( KNH4,IMODE ) / AEROSPC_MW( ANH4_IDX ) + & - CINORG( KNA, IMODE ) / AEROSPC_MW( ANA_IDX ) + +C *** Equilibrate aerosol LWC with CFINAL by calling CALC_H2O + + WI( 1 ) = CINORG( KNA, IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANA_IDX ), 8 ) + WI( 2 ) = SO4 * 1.0D-6 / REAL( AEROSPC_MW( ASO4_IDX ), 8 ) + WI( 3 ) = CFINAL( KNH4,IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANH4_IDX ), 8 ) + WI( 4 ) = CFINAL( KNO3,IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANO3_IDX ), 8 ) + WI( 5 ) = CFINAL( KCL, IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ACL_IDX ), 8 ) + + CALL CALC_H2O( WI, RHI, TEMPI, H2O_NEW ) + + H2O = H2O_NEW * DFH2OR8 + +C *** Compute net change in 3rd moment due to dry inorganic mass transfer + + DDRYM3DT = ( + & ( CFINAL( KNH4,IMODE ) - CINORG( KNH4,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANH4_IDX )%DENSITY, 8 ) ) + & + ( CFINAL( KNO3,IMODE ) - CINORG( KNO3,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANO3_IDX )%DENSITY, 8 ) ) + & + ( CFINAL( KCL, IMODE ) - CINORG( KCL,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ACL_IDX )%DENSITY, 8 ) ) + & + ( SO4 - CINORG( KSO4,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ASO4_IDX )%DENSITY, 8 ) ) ) / TSTEP + +C *** Compute net change in 2nd moment due to dry inorganic mass transfer +C (including nucleation) using equation A7 of Binkowski & Shankar (1995) + DDRYM2DT = D_TWOTHIRDS * GRFAC1( IMODE ) / GRFAC2( IMODE ) * DDRYM3DT + +C *** Update dry 2nd moment for condensation/evaporation based on whether +C net change in dry 2nd moment is production or loss + IF ( DDRYM2DT .LT. 0.0D0 ) THEN + LOSS = DDRYM2DT / DRYM20 + Y = DRYM20 * EXP( LOSS * TSTEP ) + ELSE + Y = DRYM20 + DDRYM2DT * TSTEP + END IF + +C *** Add water and SOA to 2nd moment while preserving standard deviation + + DRYM3 = ( 1.0D-9 * F6DPI / REAL( AEROSPC( ASO4_IDX )%DENSITY, 8 ) ) * SO4 + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANH4_IDX )%DENSITY, 8 ) ) + & * CFINAL( KNH4,IMODE ) + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANO3_IDX )%DENSITY, 8 ) ) + & * CFINAL( KNO3,IMODE ) + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ACL_IDX )%DENSITY, 8 ) ) + & * CFINAL( KCL,IMODE ) + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANA_IDX )%DENSITY, 8 ) ) + & * CINORG( KNA,IMODE ) + & + M3OTHR + + WETM3 = DRYM3 + M3SOA + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( AH2O_IDX )%DENSITY, 8 ) ) * H2O + DRYM2 = MAX( REAL( AEROMODE_MINM2( IMODE ), 8 ), Y ) + WETM2 = DRYM2 * ( WETM3 / DRYM3 ) ** D_TWOTHIRDS + + + PRECURSOR_CONC( NH3_IDX ) = GNH3R8 + ( CINORG( KNH4,IMODE ) + & - CFINAL( KNH4,IMODE ) ) * NH3RAT + + PRECURSOR_CONC( HNO3_IDX ) = GNO3R8 + ( CINORG( KNO3,IMODE ) + & - CFINAL( KNO3,IMODE) ) * HNO3RAT + + PRECURSOR_CONC( HCL_IDX ) = GCLR8 + ( CINORG( KCL,IMODE ) + & - CFINAL( KCL,IMODE) ) * HCLRAT + + AEROSPC_CONC( ANH4_IDX,IMODE ) = CFINAL( KNH4,IMODE ) + AEROSPC_CONC( ANO3_IDX,IMODE ) = CFINAL( KNO3,IMODE ) + AEROSPC_CONC( ACL_IDX,IMODE ) = CFINAL( KCL, IMODE ) + AEROSPC_CONC( ASO4_IDX,IMODE ) = SO4 + AEROSPC_CONC( AH2O_IDX,IMODE ) = H2O + MOMENT2_CONC( IMODE ) = WETM2 + +C *** Update the third moments, geometric mean diameters, geometric +C standard deviations, modal mass totals, and modal particle +C densities. + + CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) + + END DO ! end mass transfer time step loop + + END IF ! endif for 'Hybrid' method + +C *** End of dynamic mass transfer calculations for coarse mode + + +C *** Call ISORROPIA in forward mode to calculate gas-particle equilibrium in +C the fine aerosol modes + GNH3R8 = PRECURSOR_CONC( NH3_IDX ) + GNO3R8 = PRECURSOR_CONC( HNO3_IDX ) + GCLR8 = PRECURSOR_CONC( HCL_IDX ) + +C *** Compute sulfate from total sulfate production rate [ug/m3-s] for fine +C modes; add in H2SO4 nucleated in model timestep + + SO4 = AEROSPC_CONC( ASO4_IDX,1 ) + AEROSPC_CONC( ASO4_IDX,2 ) + SO4 = SO4 + ( DMDT_SO4 + CONDSO4( 1 ) + CONDSO4( 2 ) ) * DELT * H2SO4RATM1 + + WI( 1 ) = ( AEROSPC_CONC( ANA_IDX,1 ) + AEROSPC_CONC( ANA_IDX,2 ) ) + & * 1.0D-6 / REAL( AEROSPC_MW( ANA_IDX ), 8 ) + + WI( 2 ) = SO4 * 1.0D-6 / REAL( AEROSPC_MW( ASO4_IDX ), 8 ) + + WI( 3 ) = PRECURSOR_CONC( NH3_IDX ) * 1.0D-6 / REAL( PRECURSOR_MW( NH3_IDX ), 8 ) + & + ( AEROSPC_CONC( ANH4_IDX,1 ) + AEROSPC_CONC( ANH4_IDX,2 ) ) + & * 1.0D-6 / REAL( AEROSPC_MW( ANH4_IDX ), 8 ) + + WI( 4 ) = PRECURSOR_CONC( HNO3_IDX ) * 1.0D-6 / REAL( PRECURSOR_MW( HNO3_IDX ), 8 ) + & + ( AEROSPC_CONC( ANO3_IDX,1 ) + AEROSPC_CONC( ANO3_IDX,2 ) ) + & * 1.0D-6 / REAL( AEROSPC_MW( ANO3_IDX ), 8 ) + + WI( 5 ) = PRECURSOR_CONC( HCL_IDX ) * 1.0D-6 / REAL( PRECURSOR_MW( HCL_IDX ), 8 ) + & + ( AEROSPC_CONC( ACL_IDX,1 ) + AEROSPC_CONC( ACL_IDX,2 ) ) + & * 1.0D-6 / REAL( AEROSPC_MW( ACL_IDX ), 8 ) + + CNTRL( 1 ) = 0.0D0 ! Forward Problem + CNTRL( 2 ) = 1.0D0 ! Aerosol in Metastable State + +C *** Set flags to account for mass conservation violations in ISRP3F + TRUSTCL = .TRUE. + TRUSTNH4 = .TRUE. + IF ( WI( 1 ) + WI( 5 ) .LT. 1.0D-20 ) THEN + TRUSTCL = .FALSE. + ELSE + IF ( WI( 3 ) .LT. 1.0D-10 ) TRUSTNH4 = .FALSE. + IF ( WI( 5 ) .LT. 1.0D-10 ) TRUSTCL = .FALSE. + END IF + +#ifndef noiso + CALL ISOROPIA( WI, RHI, TEMPI, CNTRL, WT, GAS, AERLIQ, + & AERSLD, SCASI, OTHER ) + +C *** Update gas-phase concentrations + PRECURSOR_CONC( NH3_IDX ) = GAS( 1 ) * 1.0D6 * REAL( PRECURSOR_MW( NH3_IDX ), 8 ) + PRECURSOR_CONC( HNO3_IDX ) = GAS( 2 ) * 1.0D6 * REAL( PRECURSOR_MW( HNO3_IDX ), 8 ) + PRECURSOR_CONC( HCL_IDX ) = GAS( 3 ) * 1.0D6 * REAL( PRECURSOR_MW( HCL_IDX ), 8 ) +#else + gas( 1 ) = real( precursor_conc( nh3_idx ), 8 ) * 1.0d-6 / real( precursor_mw( nh3_idx ), 8 ) + gas( 2 ) = real( precursor_conc( hno3_idx ), 8 ) * 1.0d-6 / real( precursor_mw( hno3_idx ), 8 ) + gas( 3 ) = real( precursor_conc( hcl_idx ), 8 ) * 1.0d-6 / real( precursor_mw( hcl_idx ), 8 ) +#endif + +C *** Change in volatile inorganic PM concentration to achieve +C equilibrium, calculated as initial-gas-phase concentration minus +C equilibrium gas-phase concentration. DVOLINORG is positive for +C condensation and negative for evaporation. + DVOLINORG( KNH4 ) = GNH3R8 * 1.0D-6 / REAL( PRECURSOR_MW( NH3_IDX ), 8 ) - GAS( 1 ) + DVOLINORG( KNO3 ) = GNO3R8 * 1.0D-6 / REAL( PRECURSOR_MW( HNO3_IDX ), 8 ) - GAS( 2 ) + + IF ( TRUSTCL ) THEN + DVOLINORG( KCL ) = GCLR8 * 1.0D-6 / REAL( PRECURSOR_MW( HCL_IDX ), 8 ) - GAS( 3 ) + ELSE + DVOLINORG( KCL ) = 0.0D0 + END IF + + IF ( DVOLINORG( KNH4 ) .LT. 0.0D0 ) THEN + DVOLMAX = -( REAL( AEROSPC_CONC( ANH4_IDX,1 ), 8 ) + & + REAL( AEROSPC_CONC( ANH4_IDX,2 ), 8 ) ) / DF( KNH4 ) + DVOLINORG( KNH4 ) = MAX( DVOLINORG( KNH4 ), DVOLMAX ) + END IF + + IF ( DVOLINORG( KNO3 ) .LT. 0.0D0 ) THEN + DVOLMAX = -( REAL( AEROSPC_CONC( ANO3_IDX,1 ), 8 ) + & + REAL( AEROSPC_CONC( ANO3_IDX,2 ), 8 ) ) / DF( KNO3 ) + DVOLINORG( KNO3 ) = MAX( DVOLINORG( KNO3 ), DVOLMAX) + END IF + + IF ( DVOLINORG( KCL ) .LT. 0.0D0 ) THEN + DVOLMAX = -( REAL( AEROSPC_CONC( ACL_IDX,1 ), 8 ) + & + REAL( AEROSPC_CONC( ACL_IDX,2 ), 8 ) ) / DF( KCL ) + DVOLINORG( KCL ) = MAX( DVOLINORG( KCL ), DVOLMAX ) + END IF + + OMEGA( 1 ) = GRFAC2( 1 ) / ( GRFAC2( 1 ) + GRFAC2( 2 ) ) ! partitioning coeff + OMEGA( 2 ) = 1.0D0 - OMEGA( 1 ) + +C *** Initialize excess evaporated mass array + DMASS = 0.0D0 + + DO IMODE = 1, 2 ! modal partitioning of equilibrium aerosol mass + + CINORG( KSO4,IMODE ) = AEROSPC_CONC( ASO4_IDX, IMODE ) + CINORG( KNH4,IMODE ) = AEROSPC_CONC( ANH4_IDX, IMODE ) + CINORG( KNO3,IMODE ) = AEROSPC_CONC( ANO3_IDX, IMODE ) + CINORG( KNA, IMODE ) = AEROSPC_CONC( ANA_IDX, IMODE ) + CINORG( KCL, IMODE ) = AEROSPC_CONC( ACL_IDX, IMODE ) + + WETM3 = MOMENT3_CONC( IMODE ) + WETM2 = MOMENT2_CONC( IMODE ) + + IF ( IMODE .EQ. 1 ) THEN + RATE = DMDT_SO4 + CONDSO4( IMODE ) + ELSE + RATE = CONDSO4( IMODE ) + END IF + + M3OTHR = 0.0 + M3SOA = 0.0 + DO I = 1, N_AEROSPC + + ! Skip organic species + IF ( I .EQ. ASO4_IDX .OR. I .EQ. ANH4_IDX .OR. I .EQ. ANO3_IDX .OR. + & I .EQ. ANA_IDX .OR. I .EQ. ACL_IDX .OR. I .EQ. AH2O_IDX ) CYCLE + + IF ( AEROSPC(I)%NO_M2WET ) THEN + M3SOA = M3SOA + & + ( 1.0D-9 * F6DPI / AEROSPC( I )%DENSITY ) + & * AEROSPC_CONC( I,IMODE ) + ELSE + M3OTHR = M3OTHR + & + ( 1.0D-9 * F6DPI / AEROSPC( I )%DENSITY ) + & * AEROSPC_CONC( I,IMODE ) + ENDIF + + END DO ! N_AEROSPC loop + + DRYM3 = WETM3 - H2OFAC * REAL( AEROSPC_CONC( AH2O_IDX,IMODE ), 8 ) - M3SOA + DRYM20 = WETM2 * ( DRYM3 / WETM3 ) ** D_TWOTHIRDS + + DO ISP = 1, NVOLINORG + + CFINAL( ISP,IMODE ) = CINORG( ISP,IMODE ) + & + OMEGA( IMODE ) * DVOLINORG( ISP ) + & * DF( ISP ) + + IF ( IMODE .EQ. 1 ) THEN + + IF ( CFINAL( ISP,IMODE ) .LT. 0.0D0 ) THEN + DMASS( ISP) = CFINAL( ISP,IMODE ) + CFINAL( ISP,IMODE ) = 0.0D0 + END IF + + ELSE + + CFINAL( ISP,IMODE ) = CFINAL( ISP,IMODE ) + DMASS( ISP ) + + IF ( CFINAL( ISP,IMODE ) .LT. 0.0D0 ) THEN + CFINAL( ISP,1 ) = CFINAL( ISP,1 ) + CFINAL( ISP,IMODE ) + CFINAL( ISP,IMODE ) = 0.0D0 + + IF ( CFINAL( ISP, 1 ) .LT. 0.0D0 ) THEN + IF ( ABS( CFINAL( ISP,1 ) ) .LT. 1.0D-15 ) THEN + CFINAL( ISP,1 ) = 0.0D0 + ELSE + WRITE( LOGDEV,* ) 'VOLINORG: Too much evaporation' + CFINAL( ISP,1 ) = 0.0D0 +! STOP + END IF + END IF + END IF + + END IF ! IMODE = 1 + + END DO + + SO4 = CINORG( KSO4,IMODE ) + RATE * CONVFAC + +C *** Double precision vars for ISORROPIA + + WI( 1 ) = CINORG( KNA, IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANA_IDX ), 8 ) + WI( 2 ) = SO4 * 1.0D-6 / REAL( AEROSPC_MW( ASO4_IDX ), 8 ) + WI( 3 ) = CFINAL( KNH4,IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANH4_IDX ), 8 ) + WI( 4 ) = CFINAL( KNO3,IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ANO3_IDX ), 8 ) + WI( 5 ) = CFINAL( KCL, IMODE ) * 1.0D-6 / REAL( AEROSPC_MW( ACL_IDX ), 8 ) + +! write( logdev,* ) wi( 1 ), wi( 2 ), wi( 3 ), wi( 4 ), wi( 5 ) +! write( logdev,* ) '===', rhi, tempi + + CALL CALC_H2O( WI, RHI, TEMPI, H2O_NEW ) + + H2O = H2O_NEW * DFH2OR8 + +C *** Compute net change in 3rd moment due to dry inorganic mass transfer +C (includes nucleated sulfate mass) + + DDRYM3DT = ( + & ( CFINAL( KNH4,IMODE ) - CINORG( KNH4,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANH4_IDX )%DENSITY, 8 ) ) + & + ( CFINAL( KNO3,IMODE ) - CINORG( KNO3,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANO3_IDX )%DENSITY, 8 ) ) + & + ( CFINAL( KCL, IMODE ) - CINORG( KCL,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ACL_IDX )%DENSITY, 8 ) ) + & + ( SO4 - CINORG( KSO4,IMODE ) ) + & * ( 1.0D-9 * F6DPI / REAL( AEROSPC( ASO4_IDX )%DENSITY, 8 ) ) ) / DELT + +C *** Compute net change in 2nd moment due to dry inorganic mass transfer +C (including nucleation) using equation A7 of Binkowski & Shankar (1995) + DDRYM2DT = D_TWOTHIRDS * GRFAC1( IMODE ) / GRFAC2( IMODE ) * DDRYM3DT + +C *** Update dry 2nd moment for condensation/evaporation based on whether +C net change in dry 2nd moment is production or loss + IF ( DDRYM2DT .LT. 0.0D0 ) THEN + LOSS = DDRYM2DT / DRYM20 + Y = DRYM20 * EXP( LOSS * DELT ) + ELSE + Y = DRYM20 + DDRYM2DT * DELT + END IF + +C *** Add water and SOA to 2nd moment while preserving standard deviation + DRYM3 = ( 1.0D-9 * F6DPI / REAL( AEROSPC( ASO4_IDX )%DENSITY, 8 ) ) * SO4 + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANH4_IDX )%DENSITY, 8 ) ) * CFINAL( KNH4,IMODE ) + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANO3_IDX )%DENSITY, 8 ) ) * CFINAL( KNO3,IMODE ) + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ACL_IDX )%DENSITY, 8 ) ) * CFINAL( KCL, IMODE ) + & + ( 1.0D-9 * F6DPI / REAL( AEROSPC( ANA_IDX )%DENSITY, 8 ) ) * CINORG( KNA, IMODE ) + & + M3OTHR + + WETM3 = DRYM3 + M3SOA + REAL( H2OFAC, 8 ) * H2O + DRYM2 = MAX( REAL( AEROMODE_MINM2( IMODE ), 8 ), Y ) + WETM2 = DRYM2 * ( WETM3 / DRYM3 ) ** D_TWOTHIRDS + + AEROSPC_CONC( ANH4_IDX, IMODE ) = CFINAL( KNH4,IMODE ) + AEROSPC_CONC( ANO3_IDX, IMODE ) = CFINAL( KNO3,IMODE ) + AEROSPC_CONC( ACL_IDX, IMODE ) = CFINAL( KCL ,IMODE ) + AEROSPC_CONC( ASO4_IDX, IMODE ) = SO4 + AEROSPC_CONC( AH2O_IDX, IMODE ) = H2O + IF ( IMODE .EQ. 1 ) MOMENT0_CONC( IMODE ) = AM0(IMODE) + DNDT * DELT + MOMENT2_CONC( IMODE ) = WETM2 + + HPLUS( IMODE ) = 0.0 + DO I = 1, N_AEROSPC + HPLUS( IMODE ) = HPLUS( IMODE ) + & - AEROSPC( I )%CHARGE * AEROSPC_CONC( I,IMODE ) / AEROSPC_MW( I ) + END DO + + END DO ! end fine mode mass transfer calculations + +C *** Update the third moments, geometric mean diameters, geometric +C standard deviations, modal mass totals, and modal particle +C densities. + CALL GETPAR( M3_WET_FLAG, LIMIT_Sg ) + +2023 FORMAT( 1X, 'VOLINORG returning negative gas concentrations from ISOROPIA:' + & /10X, 'GAS(1) = NH3, GAS(2) = HNO3, GAS(3) = HCl' ) +2029 FORMAT( 1X, '[see VOLINORG msg]' + & 1X, 'at (C,R,L): ', 3I4, 1X, 'GAS Conc:', 3( 1PE11.3 ) ) + + RETURN + END SUBROUTINE VOLINORG + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HCOND3( AM0, AM1, AM2, DV, ALPHA, CBAR, F ) + +C calculates the size-dependent term in the condensational-growth rate +C expression for the 2nd and 3rd moments of a lognormal aerosol mode +C using the harmonic mean method. This code follows Section A2 of +C Binkowski & Shankar (1995). + +C Key Subroutines/Functions called: none + +C Revision History: +C coded November 7, 2003 by Dr. Francis S. Binkowski +C Revised November 20, 2003 by F. Binkowski to have am1 and +C am2 as inputs + +C Reference: +C 1. Binkowski, F.S. and U. Shankar, The regional particulate matter +C model 1. Model description and preliminary results, J. Geophys. +C Res., Vol 100, No D12, 26101-26209, 1995. + + IMPLICIT NONE + +C *** Includes: + + INCLUDE SUBST_CONST ! physical and mathematical constants + +C *** Arguments: + + REAL( 8 ), INTENT( IN ) :: AM0 ! zeroth moment of mode [ #/m**3 ] + REAL( 8 ), INTENT( IN ) :: AM1 ! first moment of mode [ m/m**3 ] + REAL( 8 ), INTENT( IN ) :: AM2 ! second moment of mode [ m**2/m**3 ] + REAL, INTENT( IN ) :: Dv ! molecular diffusivity of the + ! condensing vapor [ m**2/s ] + REAL, INTENT( IN ) :: ALPHA ! accommodation coefficient + REAL, INTENT( IN ) :: CBAR ! kinetic velocity of condensing vapor [ m/s ] + + REAL( 8 ), INTENT( OUT ) :: F( 2 ) ! size-dependent term in condensational-growth + ! rate: F(1) = 2nd moment [ m**2/m**3 s ] + ! F(2) = 3rd moment [ m**3/m**3 s ] + +C *** Local Variables: + + REAL( 8 ) :: GNC2 ! integrals used to calculate F(1) [m^2 / m^3 s] + REAL( 8 ) :: GFM2 ! + + REAL( 8 ) :: GNC3 ! integrals used to calculate F(2) [m^3 / m^3 s] + REAL( 8 ) :: GFM3 ! + + REAL( 8 ), PARAMETER :: TWOPI = 2.0D0 * PI + REAL( 8 ), PARAMETER :: PI4 = 0.25D0 * PI + +C----------------------------------------------------------------------- + +C *** Implement equation A15 of Binkowski & Shankar (1995) for the +C 2nd and 3rd moments of a lognormal mode of arbitrary size. + + GNC2 = TWOPI * DV * AM0 ! 2nd moment, near-continuum + GNC3 = TWOPI * DV * AM1 ! 3rd moment, near-continuum + GFM2 = PI4 * ALPHA * CBAR * AM1 ! 2nd moment, free-molecular + GFM3 = PI4 * ALPHA * CBAR * AM2 ! 3rd moment, free-molecular + +C *** Implement equation A13 of Binkowski & Shankar (1995) for a +C lognormal mode of arbitrary size. These are the size-dependent +C terms in the condensational-growth rate expression, given in +C equation 7a of B&S (1995). + + F( 1 ) = GNC2 * GFM2 / ( GNC2 + GFM2 ) ! 2nd moment + F( 2 ) = GNC3 * GFM3 / ( GNC3 + GFM3 ) ! 3rd moment + + RETURN + END SUBROUTINE HCOND3 + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE NEWPART3 ( RH, Temp, XH2SO4, SO4RATE, + & DNDT, DMDT_so4, DM2DT ) +C calculates the new particle production rate due to binary nucleation +C of H2SO4 and H2O vapor. The nucleation rate is a parameterized function +C of temperature, relative humidity, and the vapor-phase H2SO4 concentration, +C following the work of Kulmala et al (1998). This rate is then used to +C determine the production rates of aerosol number, 2nd moment, and aerosol +C sulfate, following the description in Section 1.2 of Binkowski & +C Roselle (2003), except the new particles are assumed to be of 2.0 +C nm diameter instead of 3.5 nm. + +C Key Subroutines/Functions called: none + +C REVISION HISTORY: +C FSB 11/29/99 Extracted code from PARTPROD_VA subroutine of RPM +C SJR ??/??/?? New call vector and limited the mass production rate +C FSB 04/11/02 Decreased the diameter of new particles from 3.5 nm to +C 2 nm. New particles are monodispersed. +C PVB 09/21/04 Changed MWH2SO4 from 98.07354 to 98.0 g/mol for +C consistency with the mechanism files. Added in-line documentation +C with input from FSB. +C SH 03/10/11 Renamed met_data to aeromet_data + +C References: +C 1. Kulmala, M., A. Laaksonen, and L. Pirjola, Parameterizations for +C sulfuric acid/water nucleation rates. J. Geophys. Res., Vol 103, +C No D7, 8301-8307, 1998. +C 2. Binkowski, F.S. and S.J. Roselle, Models-3 Community +C Multiscale Air Quality (CMAQ) model aerosol component 1: +C Model Description. J. Geophys. Res., Vol 108, No D6, 4183 +C doi:10.1029/2001JD001409, 2003. + + USE AERO_DATA + USE AEROMET_DATA ! Includes CONST.EXT + USE PRECURSOR_DATA, ONLY: PRECURSOR_MW, SULF_IDX + + IMPLICIT NONE + +C *** Arguments: + + REAL, INTENT( IN ) :: RH ! fractional relative humidity + REAL, INTENT( IN ) :: Temp ! ambient temperature [ K ] + REAL, INTENT( IN ) :: XH2SO4 ! sulfuric acid concentration [ ug/m**3 ] + REAL, INTENT( IN ) :: SO4RATE ! gas-phase H2SO4 production rate [ ug/m**3 s ] + + REAL( 8 ), INTENT( OUT ) :: DNDT ! particle number production rate [ m^-3/s ] + REAL( 8 ), INTENT( OUT ) :: DMDT_so4 ! SO4 mass production rate [ ug/m**3 s ] + REAL( 8 ), INTENT( OUT ) :: DM2DT ! second moment production rate [ m**2/m**3 s ] + +C *** Parameters + CHARACTER( 16 ), PARAMETER :: PNAME = 'NEWPART' + +C *** Particle size parameters: + REAL, PARAMETER :: d20 = 2.0E-07 ! diameter of a new particle [cm] + REAL, PARAMETER :: d20sq = d20 * d20 ! new-particle diameter squared [cm**2] + REAL, PARAMETER :: m2_20 = 1.0E-4 * d20sq ! new-particle diameter squared [m**2] + REAL, PARAMETER :: v20 = PI6 * d20 * d20sq ! volume of a new particle [cm**3] + + REAL( 8 ) :: sulfmass ! mass of a new particle [ug] + REAL( 8 ) :: sulfmass1 ! inverse of sulfmass [ug**-1] + +C *** Local Variables used to determine nucleation rate + + LOGICAL, SAVE :: FIRSTIME = .TRUE. + + REAL, SAVE :: ugm3_ncm3 ! micrograms/m**3 to number/cm**3 + REAL Nwv ! water vapor concentration [ 1/cm**3 ] + REAL Nav0 ! saturation vapor conc of H2SO4 [ 1/cm**3 ] + REAL Nav ! H2SO4 vapor concentration [ 1/cm**3 ] + REAL Nac ! critical H2SO4 vapor concentration [ 1/cm**3 ] + REAL RA ! fractional relative acidity + REAL delta ! temperature-correction term + REAL Xal ! H2SO4 mole fraction in the critical nucleus + REAL Nsulf ! see usage + REAL( 8 ) :: chi ! factor to calculate Jnuc + REAL( 8 ) :: JnucK ! nucleation rate [ cm ** -3 s ** -1 ] + ! (Kulmala et al.) + REAL tt ! dummy variable for statement functions + +C *** Statement Functions + REAL ph2so4, ph2o ! arithmetic statement functions for saturation + ! vapor pressures of h2so4 and h2o [Pa] taken + ! from Appendix of Kulmala et al. (1998), p8306 + + ph2so4( tt ) = EXP( 27.78492066 - 10156.0 / tt ) + + ph2o( tt ) = EXP( 77.34491296 -7235.424651 / tt + & - 8.2 * LOG( tt ) + tt * 5.7113E-03 ) + +C----------------------------------------------------------------------- + + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. + ugm3_ncm3 = ( AVO / PRECURSOR_MW( SULF_IDX ) ) * 1.0e-12 ! micrograms/m**3 to number/cm**3 + END IF + +C *** Initialize variables + DNDT = 0.0D0 + DMDT_so4 = 0.0D0 + DM2DT = 0.0D0 + + sulfmass = 1.0D+3 * aerospc( ASO4_IDX )%density * v20 + sulfmass1 = 1.0D0 / sulfmass + +C *** Nucleation Rate +C Calculate the sulfuric acid/water nucleation rate. This code +C implements Section 3 of Kulmala et al. (1998). Note that all +C variables in the Kulmala parameterization are in cgs units. + +C *** Calculate water vapor concentration [1/cm**3] using ambient RH +C and the formula in Appendix of Kulmala et al. (1998), p8306. + Nwv = RH * ph2o( Temp ) / ( RGASUNIV * Temp ) * AVO * 1.0E-6 + +C *** Calculate saturation vapor concentration of H2SO4 [1/cm**3] +C using formula in the Appendix of Kulmala et al. (1998), p8306. + Nav0 = ph2so4( Temp ) / ( RGASUNIV * Temp ) * AVO * 1.0E-6 + +C *** Convert ambient H2SO4 vapor concentration into [1/cm**3] units + Nav = ugm3_ncm3 * XH2SO4 + +C *** Calculate critical concentration of H2SO4 vapor needed to produce +C 1 particle/(cm**3 s) using Equation 18 of Kulmala et al (1998) + Nac = EXP( - 14.5125 + 0.1335 * Temp + & - 10.5462 * RH + 1958.4 * RH / Temp ) + +C *** Calculate relative acidity, defined as the ambient concentration +C divided by the saturation concentration of H2SO4 vapor + RA = Nav / Nav0 + +C *** Calculate temperature correction factor using Equation 22 of +C Kulmala et al (1998) + delta = 1.0 + ( Temp - 273.15 ) / 273.15 + +C *** Calculate mole fraction of H2SO4 in the critical nucleus using +C Equation 17 of Kulmala et al (1998) + Xal = 1.2233 - 0.0154 * RA / ( RA + RH ) + 0.0102 * log( Nav ) + & - 0.0415 * LOG( Nwv ) + 0.0016 * Temp + +C *** Calculate Nsulf as defined in Equation 21 of Kulmala et al (1998) + Nsulf = LOG( Nav / Nac ) + +C *** Calculate natural log of nucleation rate using Equation 20 of +C Kulmala et al (1998) + chi = 25.1289 * Nsulf - 4890.8 * Nsulf / Temp + & - 1743.3 / Temp - 2.2479 * delta * Nsulf * RH + & + 7643.4 * Xal / Temp + & - 1.9712 * Xal * delta / RH + +C *** Calculate nucleation rate using Eq 19 of Kulmala et al (1998) + JnucK = Exp( chi ) ! [ #/cm**3 s ] + +C *** Moment Production Rates +C Calculate the production rate of number, sulfate mass, and 2nd +C moment, due to the H2SO4/H2O nucleation assuming that each critical +C nucleus grows instantaneously to 2.0 nm. This code follows Section +C 1.2 of Binkowski & Roselle (2003), except the assumed particle +C diameter has been changed from 3.5 to 2.0 nm. + +C *** Convert production rate of number to [ #/m**3 s] + DNDT = 1.0E06 * JnucK + +C *** Calculate mass production rate [ ug / (m**3 s) ] analogous to +C Equation 6a of Binkowski & Roselle (2003). Set the upper limit +C of the mass production rate as the gas-phase production rate of +C H2SO4, and adjust the number production rate accordingly. + DMDT_so4 = sulfmass * DNDT + IF ( DMDT_so4 .GT. SO4RATE ) THEN + DMDT_so4 = SO4RATE + DNDT = DMDT_SO4 * sulfmass1 + END IF + +C *** Calculate the production rate of 2nd moment [ m**2 / (m**3 s) ] +C This is similar to Equation 6c of Binkowski & Roselle (2003), +C except the factor of PI is removed and the assumed particle +C diameter is different. + DM2DT = DNDT * m2_20 + + RETURN + END SUBROUTINE NEWPART3 + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE Compute_Flux ( nvolinorg, GNH3R8, GNO3R8, GCLR8, KNH4, + & KNO3, KCL, Ceq, CondRate, Hplus, rate, J ) + +C Description +C Determines the evaporative/condensational flux of volatile +C inorganic species to aerosol modes. In cases where the resulting H+ +C flux is greater than a specified limit, the Pilinis et al. (2000) +C AS&T approach is used to modify species vapor pressures such that +C cond./evap. produces an H+ flux equal to the limit (which is +C proportional to the current mode concentration of H+). +C Routine called by VOLINORG. + +C Arguments +C Inputs +C nvolinorg: Number of Volatile inorganic species +C GNH3R8 : NH3(g) concentration (ug/m3) +C GNO3R8 : HNO3(g) concentration (ug/m3) +C GCLR8 : HCl(g) concentration (ug/m3) +C KNH4 : Index to NH4 species +C KNO3 : Index to NO3 species +C KCL : Index to NO3 species +C Ceq : vapor concentration (mol/m3) +C CondRate : effective condensation rate (I) of 3rd moment to mode +C : [treat units as (1/s)] +C Hplus : aerosol hydrogen ion concentration (mol/m3) for mode +C rate : H2SO4(g) condensation rate (ug/m3/s) for mode + +C Output +C Ceq : modified vapor concentration (mol/m3) +C J : molar cond./evap. flux of volatile inorganics (mol/m3-s) +C +C SH 03/10/11 Renamed met_data to aeromet_data + +C----------------------------------------------------------------------- + + USE AERO_DATA + USE PRECURSOR_DATA + USE AEROMET_DATA + + IMPLICIT NONE + +C Arguments: + INTEGER nvolinorg + REAL( 8 ) :: GNH3R8, GNO3R8, GCLR8 ! gas concentrations [ug/m3] + INTEGER KNH4, KNO3, KCL ! Indices to species + REAL( 8 ) :: Ceq( nvolinorg ) ! vapor concentrations [mol/m3] + REAL( 8 ) :: CondRate ! effective condensation rate (I) for 3rd moment + REAL( 8 ) :: Hplus ! hydrogen ion concentration for mode [mol/m3] + REAL( 8 ) :: rate + REAL( 8 ) :: J( nvolinorg ) ! molar cond./evap. flux [mol/m3-s] + +C Local Variables: + REAL( 8 ), PARAMETER :: Afact = 1.0D-01 ! factor for H+ limiter + REAL( 8 ), PARAMETER :: small = 1.0D-25 + REAL( 8 ) :: Cinf( nvolinorg ) ! gas concentration in mol/m3 + REAL( 8 ) :: Qk ! factor for modifying vapor press. based on H+ limit + REAL( 8 ) :: Hflux ! flux of H+ to mode from cond/evap + REAL( 8 ) :: Hlim ! maximum allowable H+ flux to mode + REAL( 8 ) :: aa, bb, cc ! terms in quadratic equation + REAL( 8 ) :: JH2SO4 ! molar flux of H2SO4(g) [mol/m3/s] + REAL( 8 ) :: CH2SO4 ! effective H2SO4(g) concentration [mol/m3] + INTEGER isp ! inorganic species index + +C----------------------------------------------------------------------- + +C Convert gas concentration from ug/m3 to mol/m3 + Cinf( KNH4 ) = GNH3R8 * 1.0D-6 / REAL( PRECURSOR_MW( NH3_IDX ), 8 ) + Cinf( KNO3 ) = GNO3R8 * 1.0D-6 / REAL( PRECURSOR_MW( HNO3_IDX ), 8 ) + Cinf( KCL ) = GCLR8 * 1.0D-6 / REAL( PRECURSOR_MW( HCL_IDX ), 8 ) + +C Calculate cond/evap fluxes (no H+ limiting) + DO isp = 1, nvolinorg + J( isp ) = CondRate * ( Cinf( isp ) - Ceq( isp ) ) + END DO + +C Convert rate to mol/m3/s and get effective Cinf for H2SO4(g) + JH2SO4 = rate * 1.0D-6 / REAL( PRECURSOR_MW( SULPRD_IDX ), 8 ) + CH2SO4 = JH2SO4 / CondRate + +C Limit H+ flux (Pilinis et al., 2000, AS&T). Note: J is flux +C to entire mode, not one particle + Hlim = Afact * Hplus + Hflux = 2.0D0 * JH2SO4 + J( KNO3 ) + J( KCL ) - J( KNH4 ) + +C If Hflux is too large, limit the flux by modifying species +C vapor pressures with Qk factor (Pilinis et al., 2000, AS&T). + IF ( ABS( Hflux ) .GT. Hlim ) THEN + Hlim = SIGN( Hlim, Hflux ) + +C Solve quadratic for Qk: aa*Qk^2 + bb*Qk + cc = 0 + aa = Ceq( KCL ) + Ceq( KNO3 ) + + bb = Hlim / CondRate + & + Cinf( KNH4) - Cinf( KNO3 ) - Cinf( KCL ) - 2.0D0 * CH2SO4 + cc = -Ceq( KNH4 ) + + Qk = 0.0D0 ! initialize Qk + + IF ( aa .LT. small .AND. 0.0D0 .LT. bb ) THEN ! bb*Qk + cc = 0 + Qk = -cc / bb + ELSE IF (aa .LT. small .AND. bb .LE. 0.0D0 ) THEN + Qk = 0.0D0 + ELSE IF (-cc .LT. small .AND. bb .LT. 0.0D0 ) THEN ! aa*Qk^2 + bb*Qk = 0 + Qk = -bb / aa + ELSE IF (-cc .LT. small .AND. 0.0D0 .LE. bb ) THEN + Qk = 0.0D0 + ELSE + Qk = ( -bb + SQRT ( bb**2 - 4.0D0 * aa * cc ) ) / ( 2.0D0 * aa ) + IF ( bb ** 2 - 4.0D0 * aa * cc .LT. 0.0D0 ) THEN + PRINT *, 'Compute_Flux, sqrt<0' + Qk = 0.0D0 + END IF + END IF + +C Modify vapor pressures and get new fluxes + IF ( Qk .GT. small ) THEN + Ceq( KNH4 ) = Ceq( KNH4 ) / Qk + Ceq( KNO3 ) = Ceq( KNO3 ) * Qk + Ceq( KCl ) = Ceq( KCl ) * Qk + DO isp = 1, nvolinorg + J( isp ) = CondRate * ( Cinf( isp ) - Ceq( isp ) ) + END DO + END IF + + END IF ! |Hflux| > Hlim + + END SUBROUTINE Compute_Flux + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE CALC_H2O ( WI, RH, T, H2O_NEW ) + +C Description +C Calculate the water content of aerosol at the new time step. Water +C calculations use the ZSR mixing rule with salts determined by the +C ISORROPIA approach. +C Routine called by VOLINORG. + +C Arguments +C Input +C WI : Concentration of components [mol/m^3] at new step +C RH : Relative humidity [0-1] +C T : Temperature [K] + +C Output +C H2O_NEW : Water [mol/m^3] content at new time step + +C----------------------------------------------------------------------- + + IMPLICIT NONE + + INTEGER, PARAMETER :: NCMP = 5 +C Arguments: + REAL( 8 ), INTENT( IN ) :: WI( NCMP ) + REAL( 8 ), INTENT( IN ) :: RH, T + REAL( 8 ), INTENT( OUT ) :: H2O_NEW + +C Parameters: + INTEGER, PARAMETER :: NPAIR = 13 + REAL( 8 ), PARAMETER :: SMALL = 1.0D-20 + REAL( 8 ), PARAMETER :: Mw = 0.018D0 ! molar mass H2O (kg/mol) + +C Local Variables: + REAL( 8 ) :: FSO4, FNH4, FNA, FNO3, FCL ! "free" ion amounts + REAL( 8 ) :: WATER ! kg of water for new time step + REAL( 8 ) :: X, Y + REAL( 8 ) :: CONC ( NCMP ) ! concentration (mol/m^3) + REAL( 8 ) :: CONCR( NPAIR ) ! concentration (mol/m^3) ion "pairs" + REAL( 8 ) :: M0I ( NPAIR ) ! single-solute molalities + INTEGER :: J + CHARACTER( 2 ) :: SC ! sub-case for composition + +C----------------------------------------------------------------------- + +C Return if small concentration + IF ( WI( 1 ) + WI( 2 ) + WI( 3 ) + WI( 4 ) + WI( 5 ) .LE. SMALL ) THEN + H2O_NEW = SMALL + RETURN + END IF + +C Set component array (mol/m^3) for determining salts + CONC = WI ! array assignment + +C Get the sub-case to use in determining salts + CALL GETSC ( CONC, RH, T, SC ) + +C Initialize ion "pairs" (i.e., salts) used in ZSR + CONCR = 0.0D0 ! array assignment + +C Depending on case, determine moles of salts in solution (i.e., CONCR) +C for ZSR calculation below + + IF ( SC .EQ. 'K2' ) THEN ! sulfate poor (NH4-SO4 system) + CONCR( 4 ) = MIN( CONC( 2 ), 0.5D0 * CONC( 3 ) ) ! (NH4)2SO4 + + ELSE IF ( SC .EQ. 'L4' .OR. SC .EQ. 'O4' ) THEN ! sulfate rich (no acid) + X = 2.0D0 * CONC( 2 ) - CONC( 3 ) ! 2SO4 - NH4 + Y = CONC( 3 ) - CONC( 2 ) ! NH4 - SO4 + IF ( X .LE. Y ) THEN + CONCR( 13 ) = X ! (NH4)3H(SO4)2 is MIN (X,Y) + CONCR( 4 ) = Y - X ! (NH4)2SO4 + ELSE + CONCR( 13 ) = Y ! (NH4)3H(SO4)2 is MIN (X,Y) + CONCR( 9 ) = X - Y ! NH4HSO4 + END IF + + ELSE IF ( SC .EQ. 'M2' .OR. SC .EQ. 'P2' ) THEN ! sulfate rich (free acid) + CONCR( 9 ) = CONC( 3 ) ! NH4HSO4 + CONCR( 7 ) = MAX( CONC( 2 )-CONC( 3 ), 0.0D0 ) ! H2SO4 + + ELSE IF ( SC .EQ. 'N3' ) THEN ! sulfate poor (NH4-SO4-NO3 system) + CONCR( 4 ) = MIN( CONC( 2 ), 0.5D0 * CONC( 3 ) ) ! (NH4)2SO4 + FNH4 = MAX( CONC( 3 ) - 2.0D0 * CONCR( 4 ), 0.0D0 ) ! available NH4 + CONCR( 5 ) = MAX( MIN( FNH4, CONC( 4 ) ), 0.0D0 ) ! NH4NO3=MIN(NH4,NO3) + + ELSE IF ( SC .EQ. 'Q5' ) THEN ! sulfate poor, sodium poor (NH4-SO4-NO3-Cl-Na) + CONCR( 2 ) = 0.5D0 * CONC( 1 ) ! Na2SO4 + FSO4 = MAX( CONC( 2 ) - CONCR( 2 ), 0.0D0 ) ! available SO4 + CONCR( 4 ) = MAX( MIN( FSO4, 0.5D0 * CONC( 3 ) ), SMALL ) ! NH42S4=MIN(NH4,S4) + FNH4 = MAX( CONC( 3 ) - 2.0D0 * CONCR( 4 ), 0.0D0 ) ! available NH4 + CONCR( 5 ) = MIN( FNH4, CONC( 4 ) ) ! NH4NO3=MIN(NH4,NO3) + FNH4 = MAX( FNH4 - CONCR( 5 ), 0.0D0 ) ! avaialable NH4 + CONCR( 6 ) = MIN( FNH4, CONC( 5 ) ) ! NH4Cl=MIN(NH4,Cl) + + ELSE IF ( SC .EQ. 'R6' ) THEN ! sulfate poor, sodium rich (NH4-SO4-NO3-Cl-Na) + CONCR( 2 ) = CONC( 2 ) ! Na2SO4 + FNA = MAX( CONC( 1 ) - 2.0D0 * CONCR( 2 ), 0.0D0 ) + + CONCR( 3 ) = MIN( FNA, CONC( 4 ) ) ! NaNO3 + FNO3 = MAX( CONC( 4 ) - CONCR( 3 ), 0.0D0 ) + FNA = MAX( FNA-CONCR( 3 ), 0.0D0 ) + + CONCR( 1 ) = MIN( FNA, CONC( 5 ) ) ! NaCl + FCL = MAX( CONC( 5 ) - CONCR( 1 ), 0.0D0 ) + FNA = MAX( FNA-CONCR( 1 ), 0.0D0 ) + + CONCR( 5 ) = MIN( FNO3, CONC( 3 ) ) ! NH4NO3 + FNO3 = MAX( FNO3-CONCR( 5 ), 0.0D0 ) + FNH4 = MAX( CONC( 3 ) - CONCR( 5 ), 0.0D0 ) + + CONCR( 6 ) = MIN( FCL, FNH4 ) ! NH4Cl + + ELSE IF ( SC .EQ. 'S6' ) THEN ! sulfate rich (no acid) (NH4-SO4-NO3-Cl-Na) + CONCR( 2 ) = 0.5D0 * CONC( 1 ) ! Na2SO4 + FSO4 = MAX( CONC( 2 ) - CONCR( 2 ), 0.0D0 ) + CONCR( 13 ) = MIN( CONC( 3 ) / 3.0D0, FSO4 / 2.0D0 ) ! (NH4)3H(SO4)2 + FSO4 = MAX( FSO4 - 2.0D0 * CONCR( 13 ), 0.0D0 ) + FNH4 = MAX( CONC( 3 ) - 3.0D0 * CONCR( 13 ), 0.0D0 ) + + IF ( FSO4 .LE. SMALL ) THEN ! reduce (NH4)3H(SO4)2, add (NH4)2SO4 + CONCR( 13 ) = MAX( CONCR( 13 ) - FNH4, 0.0D0 ) ! (NH4)3H(SO4)2 + CONCR( 4 ) = 2.0D0 * FNH4 ! (NH4)2SO4 + ELSE IF ( FNH4 .LE. SMALL ) THEN ! reduce (NH4)3H(SO4)2, add NH4HSO4 + CONCR( 9 ) = 3.0D0 * MIN( FSO4, CONCR( 13 ) ) ! NH4HSO4 + CONCR( 13 ) = MAX( CONCR( 13 ) - FSO4, 0.0D0 ) + IF ( CONCR( 2 ) .GT. SMALL ) THEN ! reduce Na2SO4, add NaHSO4 + FSO4 = MAX( FSO4 - CONCR( 9 ) / 3.0D0, 0.0D0 ) + CONCR( 12 ) = 2.0D0 * FSO4 ! NaHSO4 + CONCR( 2 ) = MAX( CONCR( 2 ) - FSO4, 0.0D0 ) ! Na2SO4 + END IF + END IF + + ELSE IF ( SC .EQ. 'T3' ) THEN ! sulfate rich (free acid) (NH4-SO4-NO3-Cl-Na) + CONCR( 9 ) = CONC( 3 ) ! NH4HSO4 + CONCR( 12 ) = CONC( 1 ) ! NAHSO4 + CONCR( 7 ) = MAX( CONC( 2 ) - CONC( 3 ) - CONC( 1 ), 0.0D0 ) ! H2SO4 + + ELSE + PRINT*, 'aero_subs.f: case not supported ', + & '(metastable reverse only)' +! STOP + END IF + +#ifndef noiso +C Get single-solute molalities for ZSR calculation + CALL GETM0I ( M0I ) +#endif + +C Calculate H2O with ZSR and determine delta water + WATER = 0.0D0 +#ifndef noiso + DO J = 1, NPAIR + WATER = WATER + CONCR( J ) / M0I( J ) + END DO +#endif + + WATER = MAX ( WATER, SMALL ) + H2O_NEW = WATER / Mw + + END SUBROUTINE CALC_H2O + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE GETM0I ( M0I ) + +!!!!!!!!!!!!!!! We want to get rid of this dependency !!!!!!!!!!!!!!!! + +C Description +C Determines single-solute molalities for the 13 possible salts at +C the ambient RH. These molalities are used in the ZSR calculation +C in CALC_H2O. Note that the molalities were determined at the beginning +C of the time step, and so they are available in the IONS common block +C of isrpia.inc. +C Routine called by CALC_H2O. + +C Arguments +C Output +C M0I : Single-solute molalities (mol/kg-H2O) for 13 salts + +C----------------------------------------------------------------------- + +! implicit none + + INCLUDE 'isrpia.inc' + +C Arguments: + REAL( 8 ), INTENT( OUT ) :: M0I( NPAIR ) + + M0I = M0 ! Array Assignment + + END SUBROUTINE GETM0I + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE GETSC ( CONC, RH, T, SC ) + +C Description +C Determines the sub-case to use for water uptake calculations. +C Follows the procedure of ISORROPIA. +C Routine called by CALC_H2O. + +C ArgumentS +C Inputs +C CONC : Concentration [mol/m^3] of aerosol components. This routine +C sets minimum CONC to 1.0D-20 +C RH : Relative humidity +C T : Temperature (K) + +C Output +C SC : Sub-case for aerosol composition + +C----------------------------------------------------------------------- + + IMPLICIT NONE + +C Parameters: + INTEGER, PARAMETER :: NCMP = 5 ! number of aerosol components + REAL( 8 ), PARAMETER :: SMALL = 1.0D-20 + +C Arguments: + REAL( 8 ), INTENT( INOUT ) :: CONC( NCMP ) + REAL( 8 ), INTENT( IN ) :: RH, T + CHARACTER( 2 ), INTENT( OUT ) :: SC + +C Local Variables: + REAL( 8 ) :: T0, TCF ! DRH(T) factor + REAL( 8 ) :: S4RAT, S4RATW, NaRAT, SRI ! sulfate & sodium ratios + REAL( 8 ) :: FSO4 ! "free" sulfate + REAL( 8 ) :: DNACL, DNH4CL, DNANO3, DNH4NO3, DNH42S4 ! DRH values + + REAL( 8 ) :: GETASR ! ISORROPIA function for sulfate ratio + + LOGICAL :: NH4S4, NH4S4N3, ALLSP ! concentration regime + +C----------------------------------------------------------------------- + + NH4S4 = .FALSE. ! NH4-SO4 + NH4S4N3 = .FALSE. ! NH4-SO4-NO3 + ALLSP = .FALSE. ! all species + +C See if any components are negligible + IF ( CONC( 1 ) + CONC( 4 ) + CONC( 5 ) .LE. SMALL ) THEN ! Na,Cl,NO3=0 + NH4S4 = .TRUE. + ELSE IF ( CONC( 1 ) + CONC( 5 ) .LE. SMALL ) THEN ! Na,Cl=0 + NH4S4N3 = .TRUE. + ELSE + ALLSP = .TRUE. + END IF + + CONC( : ) = MAX( CONC( : ), SMALL ) + +C Deliquescence RH calculations + DNH42S4 = 0.7997D0 + DNH4NO3 = 0.6183D0 + IF ( INT( T ) .NE. 298 ) THEN + T0 = 298.15D0 + TCF = 1.0D0 / T - 1.0D0 / T0 + DNH4NO3 = DNH4NO3 * EXP( 852.0D0 * TCF ) + DNH42S4 = DNH42S4 * EXP( 80.0D0 * TCF ) + DNH4NO3 = MIN( DNH4NO3, DNH42S4 ) ! adjust for curves crossing T<271K + END IF + +C Find sub-case "SC" + IF ( NH4S4 ) THEN ! NH4-S04 system + + IF ( RH .GE. DNH42S4 ) THEN + S4RATW = GETASR( CONC( 2 ), RH ) ! aerosol sulfate ratio + ELSE + S4RATW = 2.0D0 ! dry aerosol sulfate ratio + END IF + S4RAT = CONC( 3 ) / CONC( 2 ) ! sulfate ratio (NH4/SO4) + + IF ( S4RATW .LE. S4RAT ) THEN + SC = 'K2' ! sulfate poor + ELSE IF ( 1.0D0 .LE. S4RAT .AND. S4RAT .LT. S4RATW ) THEN + SC = 'L4' ! sulfate rich (no acid) + ELSE IF ( S4RAT .LT. 1.0D0 ) THEN + SC = 'M2' ! sulfate rich (free acid) + END IF + + ELSE IF ( NH4S4N3 ) THEN ! NH4-SO4-NO3 system + + IF ( RH .GE. DNH4NO3 ) THEN + S4RATW = GETASR( CONC( 2 ), RH ) + ELSE + S4RATW = 2.0D0 ! dry aerosol ratio + END IF + S4RAT = CONC( 3 ) / CONC( 2 ) + + IF ( S4RATW .LE. S4RAT ) THEN + SC = 'N3' ! sulfate poor + ELSE IF ( 1.0D0 .LE. S4RAT .AND. S4RAT .LT. S4RATW ) THEN + SC = 'O4' ! sulfate rich (no acid) + ELSE IF ( S4RAT .LT. 1.0D0 ) THEN + SC = 'P2' ! sulfate rich (free acid) + END IF + + ELSE IF ( ALLSP ) THEN ! all species + +C Adjust DRH of NH4NO3 for low temperature + DNACL = 0.7528D0 + DNANO3 = 0.7379D0 + DNH4CL = 0.7710D0 + IF ( INT( T ) .NE. 298 ) THEN + DNACL = DNACL * EXP( 25.0D0 * TCF ) + DNANO3 = DNANO3 * EXP( 304.0D0 * TCF ) + DNH4CL = DNH4Cl * EXP( 239.0D0 * TCF ) + DNH4NO3 = MIN( DNH4NO3, DNH4CL, DNANO3, DNACL ) + END IF + + IF ( RH .GE. DNH4NO3 ) THEN + FSO4 = CONC( 2 ) - CONC( 1 ) / 2.0D0 ! sulfate unbound by Na+ + FSO4 = MAX( FSO4, SMALL ) + SRI = GETASR( FSO4, RH ) + S4RATW = ( CONC( 1 ) + FSO4 * SRI ) / CONC( 2 ) + S4RATW = MIN( S4RATW, 2.0D0 ) + ELSE + S4RATW = 2.0D0 ! ratio for dry aerosol + END IF + S4RAT = ( CONC( 1 ) + CONC( 3 ) ) / CONC( 2 ) + NaRAT = CONC( 1 ) / CONC( 2 ) + + IF ( S4RATW .LE. S4RAT .AND. NaRAT .LT. 2.0D0 ) THEN + SC = 'Q5' ! sulfate poor, sodium poor + ELSE IF ( S4RAT .GE. S4RATW .AND. NaRAT .GE. 2.0D0 ) THEN + SC = 'R6' ! SO4 poor, Na rich + ELSE IF ( 1.0D0 .LE. S4RAT .AND. S4RAT .LT. S4RATW ) THEN + SC = 'S6' ! SO4 rich, no acid + ELSE IF ( S4RAT .LT. 1.0D0 ) THEN + SC = 'T3' ! sulfate rich, free acid + END IF + + END IF + + END SUBROUTINE GETSC + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + REAL FUNCTION GETAF( NI, NJ, DGNI, DGNJ, XLSGI, XLSGJ, SQRT2 ) + +C Returns the value of "Xnum" in Equations 10a and 10c +C of Binkowski and Roselle (2003), given the number concentrations, +C median diameters, and natural logs of the geometric standard +C deviations, in two lognormal modes. The value returned by GETAF +C is used subsequently in the mode merging calculations: +C GETAF = ln( Dij / Dgi ) / ( SQRT2 * ln(Sgi) ) +C where Dij is the diameter of intersection, +C Dgi is the median diameter of the smaller size mode, and +C Sgi is the geometric standard deviation of smaller mode. +C A quadratic equation is solved to obtain GETAF, following the +C method of Press et al. +C +C References: +C 1. Binkowski, F.S. and S.J. Roselle, Models-3 Community +C Multiscale Air Quality (CMAQ) model aerosol component 1: +C Model Description. J. Geophys. Res., Vol 108, No D6, 4183 +C doi:10.1029/2001JD001409, 2003. +C 2. Press, W.H., S.A. Teukolsky, W.T. Vetterling, and B.P. +C Flannery, Numerical Recipes in Fortran 77 - 2nd Edition. +C Cambridge University Press, 1992. + + IMPLICIT NONE + + REAL NI, NJ, DGNI, DGNJ, XLSGI, XLSGJ, SQRT2 + REAL AA, BB, CC, DISC, QQ, ALFA, L, YJI + +C----------------------------------------------------------------------- + +C *** Store intermediate values used for the quadratic solution +C to reduce computational burden + ALFA = XLSGI / XLSGJ + YJI = LOG( DGNJ / DGNI ) / ( SQRT2 * XLSGI ) + L = LOG( ALFA * NJ / NI) + +C *** Calculate quadratic equation coefficients & discriminant + AA = 1.0 - ALFA * ALFA + BB = 2.0 * YJI * ALFA * ALFA + CC = L - YJI * YJI * ALFA * ALFA + DISC = BB * BB - 4.0 * AA * CC + +C *** If roots are imaginary, return a negative GETAF value so that no +C mode merging takes place. + IF ( DISC .LT. 0.0 ) THEN + GETAF = - 5.0 ! error in intersection + RETURN + END IF + +C *** Equation 5.6.4 of Press et al. + QQ = -0.5 * ( BB + SIGN( 1.0, BB ) * SQRT( DISC ) ) + +C *** Return solution of the quadratic equation that corresponds to a +C diameter of intersection lying between the median diameters of +C the 2 modes. + GETAF = CC / QQ ! See Equation 5.6.5 of Press et al. + + RETURN + END FUNCTION GETAF + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE INLET25 ( DGN, XXLSG, RHOP, INFRAC ) + +C Calculates the volume fraction of a given aerosol mode that would enter +C a sharp-cut PM2.5 inlet, using equations from Jiang et al (2005). + +C Key Subroutines called: none + +C Key Functions called: ERF + +C Revision History: +C Coded Jul 2005 by Prakash Bhave +C Apr 2008 J.Kelly: corrected equation for Dst25 calculation + +C References: +C 1. Jiang, W., Smyth, S., Giroux, E., Roth, H., Yin, D., Differences +C between CMAQ fine mode particle and PM2.5 concentrations and their +C impact on model performance evaluation in the Lower Fraser Valley, +C Atmos. Environ., 40:4973-4985, 2006. +C 2. Meng, Z., Seinfeld, J.H., On the source of the submicrometer +C droplet mode of urban and regional aerosols, Aerosol Sci. and +C Technology, 20:253-265, 1994. + +C----------------------------------------------------------------------- + + IMPLICIT NONE + + INCLUDE SUBST_CONST ! for PI + +C Input variables + REAL DGN ! geometric mean Stokes diameter by number [ m ] + REAL XXLSG ! natural log of geometric standard deviation + REAL RHOP ! average particle density [ kg/m**3 ] + +C Output variable + REAL INFRAC ! fraction of particulate volume transmitted through inlet + +C Internal variables + REAL, PARAMETER :: SQRT2 = 1.4142135623731 ! SQRT( 2 ) +! REAL, PARAMETER :: PI = 3.14159265358979324 ! PI (single precision 3.141593) + + REAL, PARAMETER :: DCA25 = 2.5 ! aerodynamic diameter cut point [ um ] + REAL, PARAMETER :: B = 0.21470 ! Cunningham slip-correction approx. param [ um ] + REAL DST25 ! Stokes diameter equivalent of DCA25 + REAL DG ! DGN converted to [ um ] + REAL ERFARG ! argument of ERF, from Step#6 of Jiang et al. (2005) + +C *** Error function approximation, from Meng & Seinfeld (1994) + REAL ERF ! Error function + REAL XX ! dummy argument for ERF + ERF( XX ) = SIGN( 1.0, XX ) * SQRT( 1.0 - EXP( -4.0 * XX * XX / PI ) ) + +C ----------------------- Begin solution ------------------------------- + +C *** Convert 2.5um size cut to its equivalent Stokes diameter using +C equation 2 of Jiang et al. (2006). Note: the equation in Step 5 +C of this paper has a typo (i.e., eq. 2 is correct). + + DST25 = 0.5 * ( SQRT( B ** 2 + 4.0 * DCA25 * + & ( DCA25 + B ) * 1.0E+03 / RHOP ) - B ) + +C *** Calculate mass fraction with Dca < 2.5um, using ERF approximation +C from Meng & Seinfeld (1994) and modified form of Fk(X) equation +C in Step#6 of Jiang et al. (2005). + + DG = DGN * 1.0E+06 + ERFARG = ( LOG( DST25 ) - LOG( DG ) ) / ( SQRT2 * XXLSG ) - 3.0 * XXLSG / SQRT2 + INFRAC = 0.5 * ( 1.0 + ERF( ERFARG ) ) + + END SUBROUTINE INLET25 + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE GETVISBY( DCV1, EXT1, DCV2, EXT2 ) + +C *** This routine calculates the Pitchford & Malm visual index, +C deciview, using the Evans & Fournier extinction with 20 point +C Gauss_Hermite numerical quadrature to integrate the extincetion +C over the log normal size distribution. +C This new method reproduces the results of Willeke and Brockmann +C very very closely. +C The Heintzenberg and Baker (h&b) method used previously has been +C replaced. +C *** This also routine calculates the Pitchford & Malm visual index, +C deciview, using reconstructed extinction values from the IMPROVE +C monitoring network + +C *** References: + +C Evans, B.T.N. and G.R. Fournier, Simple approximations to +C extinction efficiency valid over all size parameters, +C Applied Optics, 29, 4666 - 4670. + +C Heintzenberg, j. and M. Baker, Applied Optics, vol. 15, no. 5, +C pp 1178-1181, 1976. +C correction in Applied Optics August 1976 does not affect this code. + +C Sisler, J. Fax dated March 18, 1998 with IMPROVE information. + +C Pitchford, M. and W. Malm, Atmos. Environ.,vol 28,no.5, +C pp 1049-1054, 1994. + +C Willeke,K. & J. E. Brockmann, Atmos. Environ., vol.11, +C pp 995 - 999, 1977. + +Coding history: +C who when what +C ------------------------------------------------------------------ +C F.S. Binkowski 5/9/95 +C coded this version to use the h&b approximation +C and alfa and c obtained from fits to adt results +C b was fit from comparisons to willeke & brockmann. +C F.S. Binkowski 9/12/95 modified code to push j-loop inside. +C F.S. Binkowski 5/13/97 made models-3 version +C F.S. Binkowski 4/20/98 changed to Evans and Fournier approach +C for extinction +C F.S. Binkowski 4/20/98 began code for reconstructed method +C F.S. Binkowski 4/24/98 merged codes for both methods +C F.S. Binkowski 5/20/98 corrected CONSTL +C F.S. Binkowski 3/9/99 Modified for variable XXLSGAT and XXLSGAC +C P.V. Bhave 1/30/08 Updated EXT2 to account for new SOA species +C J.T. Kelly 4/17/08 Modified for variable XXLSGCO +C S. Howard 3/10/11 Renamed met_data to aeromet_data +C //////// +C NOTE: This subroutine is dependent upon the variables defined in the +C IF( FIRSTIME ) section of aeroproc.f for implementation of +C coarse mode contribution. +C /////// + + USE AERO_DATA + USE SOA_DEFN + USE AEROMET_DATA ! Includes CONST.EXT + + IMPLICIT NONE + + REAL DCV1 ! block deciview (Mie) + REAL EXT1 ! block extinction [ km**-1 ] (Mie) + + REAL DCV2 ! block deciview (Reconstructed) + REAL EXT2 ! block extinction [ km**-1 ] + ! (Reconstructed) + +C *** Paramters + + REAL, PARAMETER :: LAM = 0.55E-6 ! wavelenght of visible light [ m ] + + REAL, PARAMETER :: CONSTL = 1.0E3 * PI6 / LAM ! 1.0e3 to get km**-1 + + REAL, PARAMETER :: CONST3 = PI / LAM ! Changed 3/9/99 FSB + + REAL, PARAMETER :: SCALE = 1.0E-03 ! factor to rescale units from [ 1/Mm ] to [ 1/km ] + + REAL, PARAMETER :: RAY = 0.01 ! standard value for Rayleigh extinction [ 1/km ] + REAL, PARAMETER :: RAY1 = 1.0 / RAY ! the reciprocal of Rayleigh + +C *** internal variables: + + INTEGER IRH ! percent realtive humidity as an + ! integer used for index + + REAL WFRAC ! water mass fraction + REAL NR, NI ! real and imaginary parts of the refractive index + REAL ALFV( n_mode ) ! Mie parameters for modal mass median diameters + REAL BBEXT ! dimensionless extinction coefficient + REAL BEXT( n_mode ) ! Modal extinction coefficients [ 1/km ] + + REAL FRH ! RH correction factor for sulfate and nitrate aerosols + + REAL humfac(99) ! humidity scaling factors at 1% RH values + DATA humfac/ + & 1.0000E+00, 1.0000E+00, 1.0000E+00, 1.0000E+00, 1.0000E+00, + & 1.0000E+00, 1.0000E+00, 1.0000E+00, 1.0000E+00, 1.0000E+00, + & 1.0000E+00, 1.0000E+00, 1.0000E+00, 1.0001E+00, 1.0001E+00, + & 1.0004E+00, 1.0006E+00, 1.0024E+00, 1.0056E+00, 1.0089E+00, + & 1.0097E+00, 1.0105E+00, 1.0111E+00, 1.0115E+00, 1.0118E+00, + & 1.0122E+00, 1.0126E+00, 1.0130E+00, 1.0135E+00, 1.0139E+00, + & 1.0173E+00, 1.0206E+00, 1.0254E+00, 1.0315E+00, 1.0377E+00, + & 1.0486E+00, 1.0596E+00, 1.0751E+00, 1.0951E+00, 1.1151E+00, + & 1.1247E+00, 1.1343E+00, 1.1436E+00, 1.1525E+00, 1.1615E+00, + & 1.1724E+00, 1.1833E+00, 1.1955E+00, 1.2090E+00, 1.2224E+00, + & 1.2368E+00, 1.2512E+00, 1.2671E+00, 1.2844E+00, 1.3018E+00, + & 1.3234E+00, 1.3450E+00, 1.3695E+00, 1.3969E+00, 1.4246E+00, + & 1.4628E+00, 1.5014E+00, 1.5468E+00, 1.5992E+00, 1.6516E+00, + & 1.6991E+00, 1.7466E+00, 1.7985E+00, 1.8549E+00, 1.9113E+00, + & 1.9596E+00, 2.0080E+00, 2.0596E+00, 2.1146E+00, 2.1695E+00, + & 2.2630E+00, 2.3565E+00, 2.4692E+00, 2.6011E+00, 2.7330E+00, + & 2.8461E+00, 2.9592E+00, 3.0853E+00, 3.2245E+00, 3.3637E+00, + & 3.5743E+00, 3.7849E+00, 4.0466E+00, 4.3594E+00, 4.6721E+00, + & 5.3067E+00, 5.9412E+00, 6.9627E+00, 8.3710E+00, 9.7793E+00, + & 1.2429E+01, 1.5078E+01, 1.8059E+01, 2.1371E+01/ + + SAVE humfac + + INTEGER N ! loop counter + +C----------------------------------------------------------------------- + +C NOTE: In the following calculations, the contribution from the +C coarse mode is ignored. + +C *** calculate the mass fraction of aerosol water + + WFRAC = MIN( ( AEROSPC_CONC( AH2O_IDX,1 ) + AEROSPC_CONC( AH2O_IDX,2 ) ) + & / ( AEROMODE_MASS( 1 ) + AEROMODE_MASS( 2 ) ), 1.0 ) + +C *** interpolate between "dry" state with m = 1.5 - 0.01i +C and pure water particle with m = 1.33 - 0.0i as a function of +C wfrac + + NR = 1.5 - 0.17 * WFRAC ! real part of refractive index + NI = 0.01 * ( 1.0 - WFRAC ) ! imaginary part of refractive index + +C *** set up Mie parameters for Volume ( mass median diameter) + + DO N = 1, N_MODE + ALFV( N ) = CONST3 * AEROMODE_DIAM( N ) + & * EXP( 3.0 * AEROMODE_SDEV( N ) * AEROMODE_SDEV( N ) ) + END DO + +C *** Call extinction routines + + DO N = 1, N_MODE + CALL GETBEXT( NR, NI, ALFV( N ), AEROMODE_SDEV( N ), BBEXT ) + BEXT( N ) = CONSTL * MOMENT3_CONC( N ) * BBEXT + END DO + + BEXT( N_MODE ) = 0.0 + + EXT1 = BEXT( 1 ) + BEXT( 2 ) + RAY + + DCV1 = 10.0 * LOG ( EXT1 * RAY1 ) + +C note if EXT1 < 0.01 then DCV1 is negative. +C this implies that visual range is greater than the Rayleigh limit. +C The definition of deciviews is based upon the Rayleigh limit +C being the maximum visual range +C thus, set a floor of 0.0 on DCV1. + + DCV1 = MAX( 0.0, DCV1 ) + +C *** begin IMPROVE reconstructed method + + IRH = INT( 100.0 * AIRRH ) ! truncate relative humidity to + ! nearest integer + IRH = MIN( 99, IRH ) ! set maximum value on IRH + IRH = MAX( 1, IRH ) ! set minimum value on IRH + + + FRH = humfac( IRH ) ! set humidity correction + +C *** NOTE in the following the fine primary mass "other" is +C treated as though it were fine mass soil. + + EXT2 = 0.0 + + ! sum from aerospc species + DO N = 1, N_AEROSPC + IF ( N .EQ. ASO4_IDX .OR. N .EQ. ANO3_IDX .OR. N .EQ. ANH4_IDX ) THEN + IF ( AEROSPC( N )%NAME( 1 ) .NE. ' ' ) THEN + EXT2 = EXT2 + FRH * AEROSPC( N )%VISUAL_IDX * AEROSPC_CONC( N,1 ) + END IF + IF ( AEROSPC(N )%NAME( 2 ) .NE. ' ' ) THEN + EXT2 = EXT2 + FRH * AEROSPC( N )%VISUAL_IDX * AEROSPC_CONC( N,2 ) + END IF + CYCLE + END IF + + IF ( AEROSPC( N )%NAME( 1 ) .NE. ' ' ) THEN + EXT2 = EXT2 + AEROSPC( N )%VISUAL_IDX * AEROSPC_CONC( N,1 ) + END IF + IF ( AEROSPC( N )%NAME( 2 ) .NE. ' ' ) THEN + EXT2 = EXT2 + AEROSPC( N )%VISUAL_IDX * AEROSPC_CONC( N,2 ) + END IF + END DO + + ! sum from soa species + DO N = 1, N_VAPOR + EXT2 = EXT2 + 4.0 * AEROSPC_CONC( SOA_AEROMAP( N ),2 ) + END DO + + EXT2 = SCALE * EXT2 + RAY + + DCV2 = 10.0 * LOG ( EXT2 * RAY1 ) + +C note if EXT2 < RAY then DCV2 is negative. +C this implies that visual range is greater than the Rayleigh limit. +C The definition of deciviews is based upon the Rayleigh limit +C being the maximum visual range +C thus, set a floor of 0.0 on BLKDCV. + + DCV2 = MAX( 0.0, DCV2 ) + + RETURN + END SUBROUTINE GETVISBY + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + subroutine getbext(nr, ni, alfv, xlnsig, bext) + +C calculates the extinction coefficient normalized by wavelength +C and total particle volume concentration for a log normal +C particle distribution with the logarithm of the +C geometric standard deviation given by xlnsig. + +C *** does gauss-hermite quadrature of Qext / alfa +C over log normal distribution +C using 20 symmetric points + + implicit none + + include SUBST_CONST + + real nr, ni ! indices of refraction + real alfv ! Mie parameter for dgv + real xlnsig ! log of geometric standard deviation + real bext ! normalized extinction coefficient + real aa, aa1 ! see below for definition + + real alfaip, alfaim ! Mie parameters at abscissas + + real xxqalf ! function to calculate the extinction ceofficient + real qalfip, qalfim ! extinction efficiencies at abscissas + +! real, parameter :: pi = 3.14159265 +! real, parameter :: sqrtpi = 1.77245385 +! real, parameter :: sqrtpi1 = 1.0 / sqrtpi + real, parameter :: sqrt2 = 1.41421356 +! real, parameter :: three_pi_two = 3.0 * pi / 2.0 +! real, parameter :: const = three_pi_two * sqrtpi1 + + integer i + real const, sum, xi, wxi, xf + + integer, parameter :: n = 10 ! one-half the number of abscissas + real ghxi( n ) ! Gauss-Hermite abscissas + real ghwi( n ) ! Gauss-Hermite weights + +C *** the following weights and abscissas are from abramowitz and +C stegun, page 924 +C *** tests show that 20 point is adquate. + + data ghxi / 0.245341, 0.737474, 1.234076, 1.738538, 2.254974, + & 2.788806, 3.347855, 3.944764, 4.603682, 5.387481 / + + data ghwi/ 4.622437e-1, 2.866755e-1, 1.090172e-1, 2.481052e-2, + & 3.243773e-3, 2.283386e-4, 7.802556e-6, 1.086069e-7, + & 4.399341e-10, 2.229394e-13 / + + sum = 0.0 + + aa = 1.0 / ( sqrt2 * xlnsig ) + aa1 = sqrt2 * xlnsig ! multiplication cheaper than another division + + do i = 1, n + + xi = ghxi( i ) + wxi = ghwi( i) + xf = exp( xi * aa1 ) + alfaip = alfv * xf + alfaim = alfv / xf + qalfip = xxqalf( alfaip, nr, ni ) + qalfim = xxqalf( alfaim, nr, ni ) + + sum = sum + wxi * ( qalfip + qalfim ) + + end do ! i + +C fsb bext = const * aa * sum + const = 3.0 * sqrt( pi ) / 2.0 + bext = const * sum ! corrected 07/21/2000 FSB; found by Rokjin Park + + return + end subroutine getbext + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + real function xxqalf( alfa, nr, ni ) + +C *** compute the extinction efficiency divided by the Mie parameter +C reference: +C Evans, B.T.N. and G.R. Fournier, Simple approximations to +C extinction efficiency valid over all size parameters, +C Applied Optics, 29, 4666 - 4670. + + implicit none + + real alfa + real nr, ni ! real and imaginary parts of index of refraction + + real qextray + real qextadt + real qextef + real tt ! edge effect factor + real mu, mum1 ! exponents in formula + real aa ! first coefficient in mu + real gg ! second coefficient in mu + real nrm1, sqrtni + real alfm23 ! functions of alfa (mie parameter) + + real, parameter :: three5 = 3.0 / 5.0, + & three4 = 3.0 / 4.0, + & two3 = 2.0 / 3.0 + + nrm1 = nr - 1.0 + sqrtni = sqrt (ni ) + + call adtqext( alfa, nr, ni, qextadt ) + call pendrfx( alfa, nr, ni, qextray ) + + if ( alfa .gt. 0.5 ) then + + alfm23 = 1.0 / alfa ** two3 + tt = 2.0 - exp( -alfm23 ) + + aa = 0.5 + ( nrm1 - two3 * sqrtni - 0.5 * ni ) + & + ( nrm1 + two3 * ( sqrtni - 5.0 * ni ) ) ** 2 + + gg = three5 - three4 * sqrt ( nrm1) + 3.0 * nrm1 ** 4 + & + 25.0 * ni / ( 6.0 * ni + 5.0 * nrm1 ) + + mu = aa + gg / alfa + mum1 = - 1.0 / mu + + qextef = qextray + & * ( 1.0 + (qextray /( qextadt * tt)) ** mu ) ** mum1 + + else + + qextef = qextray ! Use Rayleigh extinction for really small alfa's + + end if ! check on alfa + + xxqalf = qextef / alfa + + return + end function xxqalf + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + subroutine adtqext( alfa, nr, ni, QEXT ) + +C *** van de Hulst approximation for QEXT. +C *** This approximation is known as Anomalous Diffraction Theory (ADT) + +C *** originally coded by Dr Francis S. Binkowski, +C AMAB/MD/ESRL RTP,N.C. 27711 28 July 1977. +C corrected 7/19/90 by fsb. +C revised 1/8/98 by FSB + +C *** reference: +C van de Hulst- Light Scattering by Small Particles, +C Dover,1981 page 179. Original edition was Wiley, 1957. + + implicit none + + real alfa ! Mie parameter + real nr, ni ! real and imaginary parts of the index of refraction + real QEXT ! extinction efficiency for a sphere + real z, tanb, b, cos2b, v1, v2, x, expmx, expm2x, cs1, cs2 + real twob, cosb + real nr1 + + nr1 = nr - 1.0 + z = 2.0 * alfa * nr1 + tanb = ni / nr1 + b = atan( tanb ) + cosb = cos( b ) + twob = 2.0 * b + cos2b = cos( twob ) + v1 = 5.0 * nr1 + v2 = 4.08 / ( 1.0 + 3.0 * tanb ) + x = z * tanb + expmx = exp( -x ) + expm2x = exp( -2.0 * x ) + cs1 = cosb / z + cs2 = cs1 * cs1 + + QEXT = 2.0 - 4.0 * cs1 * expmx * sin( z - b ) + & + 4.0 * cs2 * ( cos2b - expmx * cos(z - twob ) ) + return + end subroutine adtqext + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + subroutine pendrfx( alfa, nr, ni, QEXT ) + +C *** calculates the Mie efficiencies for extinction, scattering and +C absorption using Penndorf's approximations for small +C values of alfa. + +C input: +C nr the real part of the refractive index. +C ni the imaginary part of the refractive index +C alfa mie parameter + +C output: +C QEXT extinction efficiency + +C *** Reference: +C Penndorf, r., Scattering and extinction coefficients for small +C aerosols, J. Atmos. Sci., 19, p 193, 1962. +C +C *** Coded by Dr Francis S. Binkowski, +C AMAB/MD/ESRL RTP,N.C. 27711 28 July 1977. +C corrected 7/19/90 by FSB +C modified 30 september 1992 by FSB +C modified 1/6/98 by FSB + + implicit none + + real alfa, nr, ni + real QEXT + real alf2, alf3, alf4 + + real a1, a2, a3 + real xnr, xni, xnr2, xni2, xnri, xnri2, xnrmi + real xri, xri2, xri36, xnx, xnx2 + real z1, z12, z2, xc1 + + xnr = nr + xni = ni + xnr2 = xnr * xnr + xni2 = xni * xni + xnri = xnr2 + xni2 + xnri2 = xnri * xnri + xnrmi = xnr2 - xni2 + xri = xnr * xni + xri2 = xri * xri + xri36 = 36.0 * xri2 + xnx = xnri2 + xnrmi - 2.0 + xnx2 = xnx * xnx + + z1 = xnri2 + 4.0 * xnrmi + 4.0 + z12 = z1 * z1 + z2 = 4.0 * xnri2 + 12.0 * xnrmi + 9.0 + xc1 = 8.0 / ( 3.0 * z12 ) + + alf2 = alfa * alfa + alf3 = alfa * alf2 + alf4 = alfa * alf3 + + a1 = 24.0 * xri / z1 + + a2 = 4.0 * xri / 15.0 + 20.0 * xri / ( 3.0 * z2 ) + & + 4.8 * xri * ( 7.0 * xnri2 + & + 4.0 * ( xnrmi - 5.0 ) ) / z12 + + a3 = xc1 * ( xnx2 - xri36 ) + + QEXT = a1 * alfa + a2 * alf3 + a3 * alf4 + + return + end subroutine pendrfx + diff --git a/models/CCTM/aero/blank/coags.f b/models/CCTM/aero/blank/coags.f new file mode 100755 index 0000000..90a3fb7 --- /dev/null +++ b/models/CCTM/aero/blank/coags.f @@ -0,0 +1,2061 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/coags.f,v 1.4 2011/10/21 16:10:13 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE GETCOAGS( LAMDA, KFMATAC, KFMAT, KFMAC, KNC, + & DGATK, DGACC, SGATK, SGACC, XXLSGAT, XXLSGAC, + & QS11, QN11, QS22, QN22, + & QS12, QS21, QN12, QV12 ) + +c Calculates the coagulation rates using a new approximate algorithm +c for the 2nd moment. The 0th and 3rd moments are done by analytic +c expressions from Whitby et al. (1991). The correction factors are also +c similar to those from Whitby et al. (1991), but are derived from the +c Gauss-Hermite numerical quadratures used by Binkowski and Roselle (2003). + +c Revision History: +c FSB 08/25/03 Coded by Dr. Francis S. Binkowksi +c FSB 08/25/04 Added in-line documentation + +c References: +c 1. Whitby, E. R., P. H. McMurry, U. Shankar, and F. S. Binkowski, +c Modal Aerosol Dynamics Modeling, Rep. 600/3-91/020, Atmospheric +c Research and Exposure Assessment Laboratory, +c U.S. Environmental Protection Agency, Research Triangle Park, N.C., +c (NTIS PB91-161729/AS), 1991 +c +c 2. Binkowski, F.S. an U. Shankar, The Regional Particulate Matter +c Model 1. Model decsription and preliminary Results, Journal of +c Geophysical Research, 100, D12, pp 26,191-26,209, +c December 20, 1995. +c +c 3. Binkowski, F.S. and S.J. Roselle, Models-3 Community +c Multiscale Air Quality (CMAQ) model aerosol component 1: +c Model Description. J. Geophys. Res., Vol 108, No D6, 4183 +c doi:10.1029/2001JD001409, 2003. +C----------------------------------------------------------------------- + + IMPLICIT NONE + +C *** Arguments: + + REAL( 8 ) :: LAMDA ! mean free path [ m ] + + ! coefficients for Free Molecular regime: + REAL( 8 ) :: KFMAT ! Aitken mode + REAL( 8 ) :: KFMAC ! accumulation mode + REAL( 8 ) :: KFMATAC ! Aitken to accumulation mode + + REAL( 8 ) :: KNC ! coefficient for Near Continuum regime + + ! modal geometric mean diameters: [ m ] + REAL( 8 ) :: DGATK ! Aitken mode + REAL( 8 ) :: DGACC ! accumulation mode + + ! modal geometric standard deviation: + REAL( 8 ) :: SGATK ! Atken mode + REAL( 8 ) :: SGACC ! accumulation mode + + ! natural log of modal geometric standard deviation: + REAL( 8 ) :: XXLSGAT ! Aitken mode + REAL( 8 ) :: XXLSGAC ! accumulation mode + + ! coagulation coefficients + REAL( 8 ) :: QS11, QN11, QS22, QN22, + & QS12, QS21, QN12, QV12 + +C *** Local Variables: + + INTEGER IBETA, N1, N2A, N2N ! indices for correction factors + + REAL( 8 ) :: I1FM_AT + REAL( 8 ) :: I1NC_AT + REAL( 8 ) :: I1_AT + + REAL( 8 ) :: I1FM_AC + REAL( 8 ) :: I1NC_AC + REAL( 8 ) :: I1_AC + + REAL( 8 ) :: I1FM + REAL( 8 ) :: I1NC + REAL( 8 ) :: I1 + + REAL( 8 ) :: CONST II + + REAL( 8 ) :: KNGAT, KNGAC + + REAL( 8 ), PARAMETER :: ONE = 1.0D0, TWO = 2.0D0, HALF = 0.5D0 +! REAL( 8 ), PARAMETER :: A = 2.492D0 + REAL( 8 ), PARAMETER :: A = 1.246D0 + REAL( 8 ), PARAMETER :: TWO3RDS = 2.D0 / 3.D0 + + REAL( 8 ) :: SQRTTWO ! sqrt(2.0) + REAL( 8 ) :: DLGSQT2 ! 1/ln( sqrt( 2.0 ) ) + + REAL( 8 ) :: ESAT01 ! Aitken mode exp( log^2( sigmag )/8 ) + REAL( 8 ) :: ESAC01 ! accumulation mode exp( log^2( sigmag )/8 ) + + REAL( 8 ) :: ESAT04 + REAL( 8 ) :: ESAC04 + + REAL( 8 ) :: ESAT05 + REAL( 8 ) :: ESAC05 + + REAL( 8 ) :: ESAT08 + REAL( 8 ) :: ESAC08 + + REAL( 8 ) :: ESAT09 + REAL( 8 ) :: ESAC09 + + REAL( 8 ) :: ESAT16 + REAL( 8 ) :: ESAC16 + + REAL( 8 ) :: ESAT20 + REAL( 8 ) :: ESAC20 + + REAL( 8 ) :: ESAT24 + REAL( 8 ) :: ESAC24 + + REAL( 8 ) :: ESAT25 + REAL( 8 ) :: ESAC25 + + REAL( 8 ) :: ESAT36 + REAL( 8 ) :: ESAC36 + + REAL( 8 ) :: ESAT49 + + REAL( 8 ) :: ESAT64 + REAL( 8 ) :: ESAC64 + + REAL( 8 ) :: ESAT100 + + REAL( 8 ) :: DGAT2, DGAC2, DGAT3, DGAC3 + REAL( 8 ) :: SQDGAT, SQDGAC + REAL( 8 ) :: SQDGAT5, SQDGAC5 + REAL( 8 ) :: SQDGAT7 + REAL( 8 ) :: R, R2, R3, R4, R5, R6, R8 + REAL( 8 ) :: RI1, RI2, RI3, RI4 + REAL( 8 ) :: RAT + REAL( 8 ) :: COAGFM0, COAGNC0 + REAL( 8 ) :: COAGFM3, COAGNC3 + REAL( 8 ) :: COAGFM_AT, COAGFM_AC + REAL( 8 ) :: COAGNC_AT, COAGNC_AC + REAL( 8 ) :: COAGATAT0 + REAL( 8 ) :: COAGACAC0 + REAL( 8 ) :: COAGATAT2 + REAL( 8 ) :: COAGACAC2 + REAL( 8 ) :: COAGATAC0, COAGATAC3 + REAL( 8 ) :: COAGATAC2 + REAL( 8 ) :: COAGACAT2 + REAL( 8 ) :: XM2AT, XM3AT, XM2AC, XM3AC + +C *** correction factors for coagulation rates + REAL :: BM0 ( 10 ) ! M0 INTRAmodal FM - RPM values + REAL :: BM0IJ ( 10,10,10 ) ! M0 INTERmodal FM + REAL :: BM3I ( 10,10,10 ) ! M3 INTERmodal FM- RPM values + REAL :: BM2II ( 10 ) ! M2 INTRAmodal FM + REAL :: BM2IITT( 10 ) ! M2 INTRAmodal total + REAL :: BM2IJ ( 10,10,10 ) ! M2 INTERmodal FM i to j + REAL :: BM2JI ( 10,10,10 ) ! M2 total INTERmodal j from i + +C *** populate the arrays for the correction factors. + +C RPM 0th moment correction factors for UNIMODAL FM coagulation rates + DATA BM0 / + & 0.707106785165097, 0.726148960080488, 0.766430744110958, + & 0.814106389441342, 0.861679526483207, 0.903600509090092, + & 0.936578814219156, 0.960098926735545, 0.975646823342881, + & 0.985397173215326 / + +C FSB new FM correction factors for M0 INTERmodal coagulation + + DATA ( BM0IJ( 1, 1,IBETA ), IBETA = 1, 10 ) / + & 0.628539, 0.639610, 0.664514, 0.696278, 0.731558, + & 0.768211, 0.804480, 0.838830, 0.870024, 0.897248/ + DATA ( BM0IJ( 1, 2,IBETA ), IBETA = 1, 10 ) / + & 0.639178, 0.649966, 0.674432, 0.705794, 0.740642, + & 0.776751, 0.812323, 0.845827, 0.876076, 0.902324/ + DATA ( BM0IJ( 1, 3,IBETA ), IBETA = 1, 10 ) / + & 0.663109, 0.673464, 0.697147, 0.727637, 0.761425, + & 0.796155, 0.829978, 0.861419, 0.889424, 0.913417/ + DATA ( BM0IJ( 1, 4,IBETA ), IBETA = 1, 10 ) / + & 0.693693, 0.703654, 0.726478, 0.755786, 0.787980, + & 0.820626, 0.851898, 0.880459, 0.905465, 0.926552/ + DATA ( BM0IJ( 1, 5,IBETA ), IBETA = 1, 10 ) / + & 0.727803, 0.737349, 0.759140, 0.786870, 0.816901, + & 0.846813, 0.874906, 0.900060, 0.921679, 0.939614/ + DATA ( BM0IJ( 1, 6,IBETA ), IBETA = 1, 10 ) / + & 0.763461, 0.772483, 0.792930, 0.818599, 0.845905, + & 0.872550, 0.897051, 0.918552, 0.936701, 0.951528/ + DATA ( BM0IJ( 1, 7,IBETA ), IBETA = 1, 10 ) / + & 0.799021, 0.807365, 0.826094, 0.849230, 0.873358, + & 0.896406, 0.917161, 0.935031, 0.949868, 0.961828/ + DATA ( BM0IJ( 1, 8,IBETA ), IBETA = 1, 10 ) / + & 0.833004, 0.840514, 0.857192, 0.877446, 0.898147, + & 0.917518, 0.934627, 0.949106, 0.960958, 0.970403/ + DATA ( BM0IJ( 1, 9,IBETA ), IBETA = 1, 10 ) / + & 0.864172, 0.870734, 0.885153, 0.902373, 0.919640, + & 0.935494, 0.949257, 0.960733, 0.970016, 0.977346/ + DATA ( BM0IJ( 1, 10,IBETA ), IBETA = 1, 10 ) / + & 0.891658, 0.897227, 0.909343, 0.923588, 0.937629, + & 0.950307, 0.961151, 0.970082, 0.977236, 0.982844/ + DATA ( BM0IJ( 2, 1,IBETA ), IBETA = 1, 10 ) / + & 0.658724, 0.670587, 0.697539, 0.731890, 0.769467, + & 0.807391, 0.843410, 0.875847, 0.903700, 0.926645/ + DATA ( BM0IJ( 2, 2,IBETA ), IBETA = 1, 10 ) / + & 0.667070, 0.678820, 0.705538, 0.739591, 0.776758, + & 0.814118, 0.849415, 0.881020, 0.908006, 0.930121/ + DATA ( BM0IJ( 2, 3,IBETA ), IBETA = 1, 10 ) / + & 0.686356, 0.697839, 0.723997, 0.757285, 0.793389, + & 0.829313, 0.862835, 0.892459, 0.917432, 0.937663/ + DATA ( BM0IJ( 2, 4,IBETA ), IBETA = 1, 10 ) / + & 0.711425, 0.722572, 0.747941, 0.780055, 0.814518, + & 0.848315, 0.879335, 0.906290, 0.928658, 0.946526/ + DATA ( BM0IJ( 2, 5,IBETA ), IBETA = 1, 10 ) / + & 0.739575, 0.750307, 0.774633, 0.805138, 0.837408, + & 0.868504, 0.896517, 0.920421, 0.939932, 0.955299/ + DATA ( BM0IJ( 2, 6,IBETA ), IBETA = 1, 10 ) / + & 0.769143, 0.779346, 0.802314, 0.830752, 0.860333, + & 0.888300, 0.913014, 0.933727, 0.950370, 0.963306/ + DATA ( BM0IJ( 2, 7,IBETA ), IBETA = 1, 10 ) / + & 0.798900, 0.808431, 0.829700, 0.855653, 0.882163, + & 0.906749, 0.928075, 0.945654, 0.959579, 0.970280/ + DATA ( BM0IJ( 2, 8,IBETA ), IBETA = 1, 10 ) / + & 0.827826, 0.836542, 0.855808, 0.878954, 0.902174, + & 0.923316, 0.941345, 0.955989, 0.967450, 0.976174/ + DATA ( BM0IJ( 2, 9,IBETA ), IBETA = 1, 10 ) / + & 0.855068, 0.862856, 0.879900, 0.900068, 0.919956, + & 0.937764, 0.952725, 0.964726, 0.974027, 0.981053/ + DATA ( BM0IJ( 2, 10,IBETA ), IBETA = 1, 10 ) / + & 0.879961, 0.886755, 0.901484, 0.918665, 0.935346, + & 0.950065, 0.962277, 0.971974, 0.979432, 0.985033/ + DATA ( BM0IJ( 3, 1,IBETA ), IBETA = 1, 10 ) / + & 0.724166, 0.735474, 0.761359, 0.794045, 0.828702, + & 0.862061, 0.891995, 0.917385, 0.937959, 0.954036/ + DATA ( BM0IJ( 3, 2,IBETA ), IBETA = 1, 10 ) / + & 0.730416, 0.741780, 0.767647, 0.800116, 0.834344, + & 0.867093, 0.896302, 0.920934, 0.940790, 0.956237/ + DATA ( BM0IJ( 3, 3,IBETA ), IBETA = 1, 10 ) / + & 0.745327, 0.756664, 0.782255, 0.814026, 0.847107, + & 0.878339, 0.905820, 0.928699, 0.946931, 0.960977/ + DATA ( BM0IJ( 3, 4,IBETA ), IBETA = 1, 10 ) / + & 0.765195, 0.776312, 0.801216, 0.831758, 0.863079, + & 0.892159, 0.917319, 0.937939, 0.954145, 0.966486/ + DATA ( BM0IJ( 3, 5,IBETA ), IBETA = 1, 10 ) / + & 0.787632, 0.798347, 0.822165, 0.850985, 0.880049, + & 0.906544, 0.929062, 0.947218, 0.961288, 0.971878/ + DATA ( BM0IJ( 3, 6,IBETA ), IBETA = 1, 10 ) / + & 0.811024, 0.821179, 0.843557, 0.870247, 0.896694, + & 0.920365, 0.940131, 0.955821, 0.967820, 0.976753/ + DATA ( BM0IJ( 3, 7,IBETA ), IBETA = 1, 10 ) / + & 0.834254, 0.843709, 0.864356, 0.888619, 0.912245, + & 0.933019, 0.950084, 0.963438, 0.973530, 0.980973/ + DATA ( BM0IJ( 3, 8,IBETA ), IBETA = 1, 10 ) / + & 0.856531, 0.865176, 0.883881, 0.905544, 0.926290, + & 0.944236, 0.958762, 0.969988, 0.978386, 0.984530/ + DATA ( BM0IJ( 3, 9,IBETA ), IBETA = 1, 10 ) / + & 0.877307, 0.885070, 0.901716, 0.920729, 0.938663, + & 0.953951, 0.966169, 0.975512, 0.982442, 0.987477/ + DATA ( BM0IJ( 3, 10,IBETA ), IBETA = 1, 10 ) / + & 0.896234, 0.903082, 0.917645, 0.934069, 0.949354, + & 0.962222, 0.972396, 0.980107, 0.985788, 0.989894/ + DATA ( BM0IJ( 4, 1,IBETA ), IBETA = 1, 10 ) / + & 0.799294, 0.809144, 0.831293, 0.858395, 0.885897, + & 0.911031, 0.932406, 0.949642, 0.963001, 0.973062/ + DATA ( BM0IJ( 4, 2,IBETA ), IBETA = 1, 10 ) / + & 0.804239, 0.814102, 0.836169, 0.862984, 0.890003, + & 0.914535, 0.935274, 0.951910, 0.964748, 0.974381/ + DATA ( BM0IJ( 4, 3,IBETA ), IBETA = 1, 10 ) / + & 0.815910, 0.825708, 0.847403, 0.873389, 0.899185, + & 0.922275, 0.941543, 0.956826, 0.968507, 0.977204/ + DATA ( BM0IJ( 4, 4,IBETA ), IBETA = 1, 10 ) / + & 0.831348, 0.840892, 0.861793, 0.886428, 0.910463, + & 0.931614, 0.948993, 0.962593, 0.972872, 0.980456/ + DATA ( BM0IJ( 4, 5,IBETA ), IBETA = 1, 10 ) / + & 0.848597, 0.857693, 0.877402, 0.900265, 0.922180, + & 0.941134, 0.956464, 0.968298, 0.977143, 0.983611/ + DATA ( BM0IJ( 4, 6,IBETA ), IBETA = 1, 10 ) / + & 0.866271, 0.874764, 0.892984, 0.913796, 0.933407, + & 0.950088, 0.963380, 0.973512, 0.981006, 0.986440/ + DATA ( BM0IJ( 4, 7,IBETA ), IBETA = 1, 10 ) / + & 0.883430, 0.891216, 0.907762, 0.926388, 0.943660, + & 0.958127, 0.969499, 0.978070, 0.984351, 0.988872/ + DATA ( BM0IJ( 4, 8,IBETA ), IBETA = 1, 10 ) / + & 0.899483, 0.906505, 0.921294, 0.937719, 0.952729, + & 0.965131, 0.974762, 0.981950, 0.987175, 0.990912/ + DATA ( BM0IJ( 4, 9,IBETA ), IBETA = 1, 10 ) / + & 0.914096, 0.920337, 0.933373, 0.947677, 0.960579, + & 0.971111, 0.979206, 0.985196, 0.989520, 0.992597/ + DATA ( BM0IJ( 4, 10,IBETA ), IBETA = 1, 10 ) / + & 0.927122, 0.932597, 0.943952, 0.956277, 0.967268, + & 0.976147, 0.982912, 0.987882, 0.991450, 0.993976/ + DATA ( BM0IJ( 5, 1,IBETA ), IBETA = 1, 10 ) / + & 0.865049, 0.872851, 0.889900, 0.909907, 0.929290, + & 0.946205, 0.959991, 0.970706, 0.978764, 0.984692/ + DATA ( BM0IJ( 5, 2,IBETA ), IBETA = 1, 10 ) / + & 0.868989, 0.876713, 0.893538, 0.913173, 0.932080, + & 0.948484, 0.961785, 0.972080, 0.979796, 0.985457/ + DATA ( BM0IJ( 5, 3,IBETA ), IBETA = 1, 10 ) / + & 0.878010, 0.885524, 0.901756, 0.920464, 0.938235, + & 0.953461, 0.965672, 0.975037, 0.982005, 0.987085/ + DATA ( BM0IJ( 5, 4,IBETA ), IBETA = 1, 10 ) / + & 0.889534, 0.896698, 0.912012, 0.929395, 0.945647, + & 0.959366, 0.970227, 0.978469, 0.984547, 0.988950/ + DATA ( BM0IJ( 5, 5,IBETA ), IBETA = 1, 10 ) / + & 0.902033, 0.908713, 0.922848, 0.938648, 0.953186, + & 0.965278, 0.974729, 0.981824, 0.987013, 0.990746/ + DATA ( BM0IJ( 5, 6,IBETA ), IBETA = 1, 10 ) / + & 0.914496, 0.920599, 0.933389, 0.947485, 0.960262, + & 0.970743, 0.978839, 0.984858, 0.989225, 0.992348/ + DATA ( BM0IJ( 5, 7,IBETA ), IBETA = 1, 10 ) / + & 0.926281, 0.931761, 0.943142, 0.955526, 0.966600, + & 0.975573, 0.982431, 0.987485, 0.991128, 0.993718/ + DATA ( BM0IJ( 5, 8,IBETA ), IBETA = 1, 10 ) / + & 0.937029, 0.941877, 0.951868, 0.962615, 0.972112, + & 0.979723, 0.985488, 0.989705, 0.992725, 0.994863/ + DATA ( BM0IJ( 5, 9,IBETA ), IBETA = 1, 10 ) / + & 0.946580, 0.950819, 0.959494, 0.968732, 0.976811, + & 0.983226, 0.988047, 0.991550, 0.994047, 0.995806/ + DATA ( BM0IJ( 5, 10,IBETA ), IBETA = 1, 10 ) / + & 0.954909, 0.958581, 0.966049, 0.973933, 0.980766, + & 0.986149, 0.990166, 0.993070, 0.995130, 0.996577/ + DATA ( BM0IJ( 6, 1,IBETA ), IBETA = 1, 10 ) / + & 0.914182, 0.919824, 0.931832, 0.945387, 0.957999, + & 0.968606, 0.976982, 0.983331, 0.988013, 0.991407/ + DATA ( BM0IJ( 6, 2,IBETA ), IBETA = 1, 10 ) / + & 0.917139, 0.922665, 0.934395, 0.947580, 0.959792, + & 0.970017, 0.978062, 0.984138, 0.988609, 0.991843/ + DATA ( BM0IJ( 6, 3,IBETA ), IBETA = 1, 10 ) / + & 0.923742, 0.928990, 0.940064, 0.952396, 0.963699, + & 0.973070, 0.980381, 0.985866, 0.989878, 0.992768/ + DATA ( BM0IJ( 6, 4,IBETA ), IBETA = 1, 10 ) / + & 0.931870, 0.936743, 0.946941, 0.958162, 0.968318, + & 0.976640, 0.983069, 0.987853, 0.991330, 0.993822/ + DATA ( BM0IJ( 6, 5,IBETA ), IBETA = 1, 10 ) / + & 0.940376, 0.944807, 0.954004, 0.963999, 0.972928, + & 0.980162, 0.985695, 0.989779, 0.992729, 0.994833/ + DATA ( BM0IJ( 6, 6,IBETA ), IBETA = 1, 10 ) / + & 0.948597, 0.952555, 0.960703, 0.969454, 0.977181, + & 0.983373, 0.988067, 0.991507, 0.993977, 0.995730/ + DATA ( BM0IJ( 6, 7,IBETA ), IBETA = 1, 10 ) / + & 0.956167, 0.959648, 0.966763, 0.974326, 0.980933, + & 0.986177, 0.990121, 0.992993, 0.995045, 0.996495/ + DATA ( BM0IJ( 6, 8,IBETA ), IBETA = 1, 10 ) / + & 0.962913, 0.965937, 0.972080, 0.978552, 0.984153, + & 0.988563, 0.991857, 0.994242, 0.995938, 0.997133/ + DATA ( BM0IJ( 6, 9,IBETA ), IBETA = 1, 10 ) / + & 0.968787, 0.971391, 0.976651, 0.982148, 0.986869, + & 0.990560, 0.993301, 0.995275, 0.996675, 0.997657/ + DATA ( BM0IJ( 6, 10,IBETA ), IBETA = 1, 10 ) / + & 0.973822, 0.976047, 0.980523, 0.985170, 0.989134, + & 0.992215, 0.994491, 0.996124, 0.997277, 0.998085/ + DATA ( BM0IJ( 7, 1,IBETA ), IBETA = 1, 10 ) / + & 0.947410, 0.951207, 0.959119, 0.967781, 0.975592, + & 0.981981, 0.986915, 0.990590, 0.993266, 0.995187/ + DATA ( BM0IJ( 7, 2,IBETA ), IBETA = 1, 10 ) / + & 0.949477, 0.953161, 0.960824, 0.969187, 0.976702, + & 0.982831, 0.987550, 0.991057, 0.993606, 0.995434/ + DATA ( BM0IJ( 7, 3,IBETA ), IBETA = 1, 10 ) / + & 0.954008, 0.957438, 0.964537, 0.972232, 0.979095, + & 0.984653, 0.988907, 0.992053, 0.994330, 0.995958/ + DATA ( BM0IJ( 7, 4,IBETA ), IBETA = 1, 10 ) / + & 0.959431, 0.962539, 0.968935, 0.975808, 0.981882, + & 0.986759, 0.990466, 0.993190, 0.995153, 0.996552/ + DATA ( BM0IJ( 7, 5,IBETA ), IBETA = 1, 10 ) / + & 0.964932, 0.967693, 0.973342, 0.979355, 0.984620, + & 0.988812, 0.991974, 0.994285, 0.995943, 0.997119/ + DATA ( BM0IJ( 7, 6,IBETA ), IBETA = 1, 10 ) / + & 0.970101, 0.972517, 0.977428, 0.982612, 0.987110, + & 0.990663, 0.993326, 0.995261, 0.996644, 0.997621/ + DATA ( BM0IJ( 7, 7,IBETA ), IBETA = 1, 10 ) / + & 0.974746, 0.976834, 0.981055, 0.985475, 0.989280, + & 0.992265, 0.994488, 0.996097, 0.997241, 0.998048/ + DATA ( BM0IJ( 7, 8,IBETA ), IBETA = 1, 10 ) / + & 0.978804, 0.980591, 0.984187, 0.987927, 0.991124, + & 0.993617, 0.995464, 0.996795, 0.997739, 0.998403/ + DATA ( BM0IJ( 7, 9,IBETA ), IBETA = 1, 10 ) / + & 0.982280, 0.983799, 0.986844, 0.989991, 0.992667, + & 0.994742, 0.996273, 0.997372, 0.998149, 0.998695/ + DATA ( BM0IJ( 7, 10,IBETA ), IBETA = 1, 10 ) / + & 0.985218, 0.986503, 0.989071, 0.991711, 0.993945, + & 0.995669, 0.996937, 0.997844, 0.998484, 0.998932/ + DATA ( BM0IJ( 8, 1,IBETA ), IBETA = 1, 10 ) / + & 0.968507, 0.970935, 0.975916, 0.981248, 0.985947, + & 0.989716, 0.992580, 0.994689, 0.996210, 0.997297/ + DATA ( BM0IJ( 8, 2,IBETA ), IBETA = 1, 10 ) / + & 0.969870, 0.972210, 0.977002, 0.982119, 0.986619, + & 0.990219, 0.992951, 0.994958, 0.996405, 0.997437/ + DATA ( BM0IJ( 8, 3,IBETA ), IBETA = 1, 10 ) / + & 0.972820, 0.974963, 0.979339, 0.983988, 0.988054, + & 0.991292, 0.993738, 0.995529, 0.996817, 0.997734/ + DATA ( BM0IJ( 8, 4,IBETA ), IBETA = 1, 10 ) / + & 0.976280, 0.978186, 0.982060, 0.986151, 0.989706, + & 0.992520, 0.994636, 0.996179, 0.997284, 0.998069/ + DATA ( BM0IJ( 8, 5,IBETA ), IBETA = 1, 10 ) / + & 0.979711, 0.981372, 0.984735, 0.988263, 0.991309, + & 0.993706, 0.995499, 0.996801, 0.997730, 0.998389/ + DATA ( BM0IJ( 8, 6,IBETA ), IBETA = 1, 10 ) / + & 0.982863, 0.984292, 0.987172, 0.990174, 0.992750, + & 0.994766, 0.996266, 0.997352, 0.998125, 0.998670/ + DATA ( BM0IJ( 8, 7,IBETA ), IBETA = 1, 10 ) / + & 0.985642, 0.986858, 0.989301, 0.991834, 0.993994, + & 0.995676, 0.996923, 0.997822, 0.998460, 0.998910/ + DATA ( BM0IJ( 8, 8,IBETA ), IBETA = 1, 10 ) / + & 0.988029, 0.989058, 0.991116, 0.993240, 0.995043, + & 0.996440, 0.997472, 0.998214, 0.998739, 0.999108/ + DATA ( BM0IJ( 8, 9,IBETA ), IBETA = 1, 10 ) / + & 0.990046, 0.990912, 0.992640, 0.994415, 0.995914, + & 0.997073, 0.997925, 0.998536, 0.998968, 0.999271/ + DATA ( BM0IJ( 8, 10,IBETA ), IBETA = 1, 10 ) / + & 0.991732, 0.992459, 0.993906, 0.995386, 0.996633, + & 0.997592, 0.998296, 0.998799, 0.999154, 0.999403/ + DATA ( BM0IJ( 9, 1,IBETA ), IBETA = 1, 10 ) / + & 0.981392, 0.982893, 0.985938, 0.989146, 0.991928, + & 0.994129, 0.995783, 0.996991, 0.997857, 0.998473/ + DATA ( BM0IJ( 9, 2,IBETA ), IBETA = 1, 10 ) / + & 0.982254, 0.983693, 0.986608, 0.989673, 0.992328, + & 0.994424, 0.995998, 0.997146, 0.997969, 0.998553/ + DATA ( BM0IJ( 9, 3,IBETA ), IBETA = 1, 10 ) / + & 0.984104, 0.985407, 0.988040, 0.990798, 0.993178, + & 0.995052, 0.996454, 0.997474, 0.998204, 0.998722/ + DATA ( BM0IJ( 9, 4,IBETA ), IBETA = 1, 10 ) / + & 0.986243, 0.987386, 0.989687, 0.992087, 0.994149, + & 0.995765, 0.996971, 0.997846, 0.998470, 0.998913/ + DATA ( BM0IJ( 9, 5,IBETA ), IBETA = 1, 10 ) / + & 0.988332, 0.989313, 0.991284, 0.993332, 0.995082, + & 0.996449, 0.997465, 0.998200, 0.998723, 0.999093/ + DATA ( BM0IJ( 9, 6,IBETA ), IBETA = 1, 10 ) / + & 0.990220, 0.991053, 0.992721, 0.994445, 0.995914, + & 0.997056, 0.997902, 0.998513, 0.998947, 0.999253/ + DATA ( BM0IJ( 9, 7,IBETA ), IBETA = 1, 10 ) / + & 0.991859, 0.992561, 0.993961, 0.995403, 0.996626, + & 0.997574, 0.998274, 0.998778, 0.999136, 0.999387/ + DATA ( BM0IJ( 9, 8,IBETA ), IBETA = 1, 10 ) / + & 0.993250, 0.993837, 0.995007, 0.996208, 0.997223, + & 0.998007, 0.998584, 0.998999, 0.999293, 0.999499/ + DATA ( BM0IJ( 9, 9,IBETA ), IBETA = 1, 10 ) / + & 0.994413, 0.994903, 0.995878, 0.996876, 0.997716, + & 0.998363, 0.998839, 0.999180, 0.999421, 0.999591/ + DATA ( BM0IJ( 9, 10,IBETA ), IBETA = 1, 10 ) / + & 0.995376, 0.995785, 0.996597, 0.997425, 0.998121, + & 0.998655, 0.999048, 0.999328, 0.999526, 0.999665/ + DATA ( BM0IJ( 10, 1,IBETA ), IBETA = 1, 10 ) / + & 0.989082, 0.989991, 0.991819, 0.993723, 0.995357, + & 0.996637, 0.997592, 0.998286, 0.998781, 0.999132/ + DATA ( BM0IJ( 10, 2,IBETA ), IBETA = 1, 10 ) / + & 0.989613, 0.990480, 0.992224, 0.994039, 0.995594, + & 0.996810, 0.997717, 0.998375, 0.998845, 0.999178/ + DATA ( BM0IJ( 10, 3,IBETA ), IBETA = 1, 10 ) / + & 0.990744, 0.991523, 0.993086, 0.994708, 0.996094, + & 0.997176, 0.997981, 0.998564, 0.998980, 0.999274/ + DATA ( BM0IJ( 10, 4,IBETA ), IBETA = 1, 10 ) / + & 0.992041, 0.992716, 0.994070, 0.995470, 0.996662, + & 0.997591, 0.998280, 0.998778, 0.999133, 0.999383/ + DATA ( BM0IJ( 10, 5,IBETA ), IBETA = 1, 10 ) / + & 0.993292, 0.993867, 0.995015, 0.996199, 0.997205, + & 0.997985, 0.998564, 0.998981, 0.999277, 0.999487/ + DATA ( BM0IJ( 10, 6,IBETA ), IBETA = 1, 10 ) / + & 0.994411, 0.994894, 0.995857, 0.996847, 0.997685, + & 0.998334, 0.998814, 0.999159, 0.999404, 0.999577/ + DATA ( BM0IJ( 10, 7,IBETA ), IBETA = 1, 10 ) / + & 0.995373, 0.995776, 0.996577, 0.997400, 0.998094, + & 0.998630, 0.999026, 0.999310, 0.999512, 0.999654/ + DATA ( BM0IJ( 10, 8,IBETA ), IBETA = 1, 10 ) / + & 0.996181, 0.996516, 0.997181, 0.997861, 0.998435, + & 0.998877, 0.999202, 0.999435, 0.999601, 0.999717/ + DATA ( BM0IJ( 10, 9,IBETA ), IBETA = 1, 10 ) / + & 0.996851, 0.997128, 0.997680, 0.998242, 0.998715, + & 0.999079, 0.999346, 0.999538, 0.999673, 0.999769/ + DATA ( BM0IJ( 10, 10,IBETA ), IBETA = 1, 10 ) / + & 0.997402, 0.997632, 0.998089, 0.998554, 0.998945, + & 0.999244, 0.999464, 0.999622, 0.999733, 0.999811/ + +C RPM.... 3rd moment nuclei mode corr. fac. for bimodal FM coag rate + DATA ( BM3I( 1, 1,IBETA ), IBETA = 1, 10 ) / + + 0.70708,0.71681,0.73821,0.76477,0.79350,0.82265,0.85090,0.87717, + + 0.90069,0.92097/ + DATA ( BM3I( 1, 2,IBETA ), IBETA = 1, 10 ) / + + 0.72172,0.73022,0.74927,0.77324,0.79936,0.82601,0.85199,0.87637, + + 0.89843,0.91774/ + DATA ( BM3I( 1, 3,IBETA ), IBETA = 1, 10 ) / + + 0.78291,0.78896,0.80286,0.82070,0.84022,0.85997,0.87901,0.89669, + + 0.91258,0.92647/ + DATA ( BM3I( 1, 4,IBETA ), IBETA = 1, 10 ) / + + 0.87760,0.88147,0.89025,0.90127,0.91291,0.92420,0.93452,0.94355, + + 0.95113,0.95726/ + DATA ( BM3I( 1, 5,IBETA ), IBETA = 1, 10 ) / + + 0.94988,0.95184,0.95612,0.96122,0.96628,0.97085,0.97467,0.97763, + + 0.97971,0.98089/ + DATA ( BM3I( 1, 6,IBETA ), IBETA = 1, 10 ) / + + 0.98318,0.98393,0.98551,0.98728,0.98889,0.99014,0.99095,0.99124, + + 0.99100,0.99020/ + DATA ( BM3I( 1, 7,IBETA ), IBETA = 1, 10 ) / + + 0.99480,0.99504,0.99551,0.99598,0.99629,0.99635,0.99611,0.99550, + + 0.99450,0.99306/ + DATA ( BM3I( 1, 8,IBETA ), IBETA = 1, 10 ) / + + 0.99842,0.99848,0.99858,0.99861,0.99850,0.99819,0.99762,0.99674, + + 0.99550,0.99388/ + DATA ( BM3I( 1, 9,IBETA ), IBETA = 1, 10 ) / + + 0.99951,0.99951,0.99949,0.99939,0.99915,0.99872,0.99805,0.99709, + + 0.99579,0.99411/ + DATA ( BM3I( 1,10,IBETA ), IBETA = 1, 10 ) / + + 0.99984,0.99982,0.99976,0.99962,0.99934,0.99888,0.99818,0.99719, + + 0.99587,0.99417/ + DATA ( BM3I( 2, 1,IBETA ), IBETA = 1, 10 ) / + + 0.72957,0.73993,0.76303,0.79178,0.82245,0.85270,0.88085,0.90578, + + 0.92691,0.94415/ + DATA ( BM3I( 2, 2,IBETA ), IBETA = 1, 10 ) / + + 0.72319,0.73320,0.75547,0.78323,0.81307,0.84287,0.87107,0.89651, + + 0.91852,0.93683/ + DATA ( BM3I( 2, 3,IBETA ), IBETA = 1, 10 ) / + + 0.74413,0.75205,0.76998,0.79269,0.81746,0.84258,0.86685,0.88938, + + 0.90953,0.92695/ + DATA ( BM3I( 2, 4,IBETA ), IBETA = 1, 10 ) / + + 0.82588,0.83113,0.84309,0.85825,0.87456,0.89072,0.90594,0.91972, + + 0.93178,0.94203/ + DATA ( BM3I( 2, 5,IBETA ), IBETA = 1, 10 ) / + + 0.91886,0.92179,0.92831,0.93624,0.94434,0.95192,0.95856,0.96409, + + 0.96845,0.97164/ + DATA ( BM3I( 2, 6,IBETA ), IBETA = 1, 10 ) / + + 0.97129,0.97252,0.97515,0.97818,0.98108,0.98354,0.98542,0.98665, + + 0.98721,0.98709/ + DATA ( BM3I( 2, 7,IBETA ), IBETA = 1, 10 ) / + + 0.99104,0.99145,0.99230,0.99320,0.99394,0.99439,0.99448,0.99416, + + 0.99340,0.99217/ + DATA ( BM3I( 2, 8,IBETA ), IBETA = 1, 10 ) / + + 0.99730,0.99741,0.99763,0.99779,0.99782,0.99762,0.99715,0.99636, + + 0.99519,0.99363/ + DATA ( BM3I( 2, 9,IBETA ), IBETA = 1, 10 ) / + + 0.99917,0.99919,0.99921,0.99915,0.99895,0.99856,0.99792,0.99698, + + 0.99570,0.99404/ + DATA ( BM3I( 2,10,IBETA ), IBETA = 1, 10 ) / + + 0.99973,0.99973,0.99968,0.99955,0.99928,0.99883,0.99814,0.99716, + + 0.99584,0.99415/ + DATA ( BM3I( 3, 1,IBETA ), IBETA = 1, 10 ) / + + 0.78358,0.79304,0.81445,0.84105,0.86873,0.89491,0.91805,0.93743, + + 0.95300,0.96510/ + DATA ( BM3I( 3, 2,IBETA ), IBETA = 1, 10 ) / + + 0.76412,0.77404,0.79635,0.82404,0.85312,0.88101,0.90610,0.92751, + + 0.94500,0.95879/ + DATA ( BM3I( 3, 3,IBETA ), IBETA = 1, 10 ) / + + 0.74239,0.75182,0.77301,0.79956,0.82809,0.85639,0.88291,0.90658, + + 0.92683,0.94350/ + DATA ( BM3I( 3, 4,IBETA ), IBETA = 1, 10 ) / + + 0.78072,0.78758,0.80317,0.82293,0.84437,0.86589,0.88643,0.90526, + + 0.92194,0.93625/ + DATA ( BM3I( 3, 5,IBETA ), IBETA = 1, 10 ) / + + 0.87627,0.88044,0.88981,0.90142,0.91357,0.92524,0.93585,0.94510, + + 0.95285,0.95911/ + DATA ( BM3I( 3, 6,IBETA ), IBETA = 1, 10 ) / + + 0.95176,0.95371,0.95796,0.96297,0.96792,0.97233,0.97599,0.97880, + + 0.98072,0.98178/ + DATA ( BM3I( 3, 7,IBETA ), IBETA = 1, 10 ) / + + 0.98453,0.98523,0.98670,0.98833,0.98980,0.99092,0.99160,0.99179, + + 0.99145,0.99058/ + DATA ( BM3I( 3, 8,IBETA ), IBETA = 1, 10 ) / + + 0.99534,0.99555,0.99597,0.99637,0.99662,0.99663,0.99633,0.99569, + + 0.99465,0.99318/ + DATA ( BM3I( 3, 9,IBETA ), IBETA = 1, 10 ) / + + 0.99859,0.99864,0.99872,0.99873,0.99860,0.99827,0.99768,0.99679, + + 0.99555,0.99391/ + DATA ( BM3I( 3,10,IBETA ), IBETA = 1, 10 ) / + + 0.99956,0.99956,0.99953,0.99942,0.99918,0.99875,0.99807,0.99711, + + 0.99580,0.99412/ + DATA ( BM3I( 4, 1,IBETA ), IBETA = 1, 10 ) / + + 0.84432,0.85223,0.86990,0.89131,0.91280,0.93223,0.94861,0.96172, + + 0.97185,0.97945/ + DATA ( BM3I( 4, 2,IBETA ), IBETA = 1, 10 ) / + + 0.82299,0.83164,0.85101,0.87463,0.89857,0.92050,0.93923,0.95443, + + 0.96629,0.97529/ + DATA ( BM3I( 4, 3,IBETA ), IBETA = 1, 10 ) / + + 0.77870,0.78840,0.81011,0.83690,0.86477,0.89124,0.91476,0.93460, + + 0.95063,0.96316/ + DATA ( BM3I( 4, 4,IBETA ), IBETA = 1, 10 ) / + + 0.76386,0.77233,0.79147,0.81557,0.84149,0.86719,0.89126,0.91275, + + 0.93116,0.94637/ + DATA ( BM3I( 4, 5,IBETA ), IBETA = 1, 10 ) / + + 0.82927,0.83488,0.84756,0.86346,0.88040,0.89704,0.91257,0.92649, + + 0.93857,0.94874/ + DATA ( BM3I( 4, 6,IBETA ), IBETA = 1, 10 ) / + + 0.92184,0.92481,0.93136,0.93925,0.94724,0.95462,0.96104,0.96634, + + 0.97048,0.97348/ + DATA ( BM3I( 4, 7,IBETA ), IBETA = 1, 10 ) / + + 0.97341,0.97457,0.97706,0.97991,0.98260,0.98485,0.98654,0.98760, + + 0.98801,0.98777/ + DATA ( BM3I( 4, 8,IBETA ), IBETA = 1, 10 ) / + + 0.99192,0.99229,0.99305,0.99385,0.99449,0.99486,0.99487,0.99449, + + 0.99367,0.99239/ + DATA ( BM3I( 4, 9,IBETA ), IBETA = 1, 10 ) / + + 0.99758,0.99768,0.99787,0.99800,0.99799,0.99777,0.99727,0.99645, + + 0.99527,0.99369/ + DATA ( BM3I( 4,10,IBETA ), IBETA = 1, 10 ) / + + 0.99926,0.99928,0.99928,0.99921,0.99900,0.99860,0.99795,0.99701, + + 0.99572,0.99405/ + DATA ( BM3I( 5, 1,IBETA ), IBETA = 1, 10 ) / + + 0.89577,0.90190,0.91522,0.93076,0.94575,0.95876,0.96932,0.97751, + + 0.98367,0.98820/ + DATA ( BM3I( 5, 2,IBETA ), IBETA = 1, 10 ) / + + 0.87860,0.88547,0.90052,0.91828,0.93557,0.95075,0.96319,0.97292, + + 0.98028,0.98572/ + DATA ( BM3I( 5, 3,IBETA ), IBETA = 1, 10 ) / + + 0.83381,0.84240,0.86141,0.88425,0.90707,0.92770,0.94510,0.95906, + + 0.96986,0.97798/ + DATA ( BM3I( 5, 4,IBETA ), IBETA = 1, 10 ) / + + 0.78530,0.79463,0.81550,0.84127,0.86813,0.89367,0.91642,0.93566, + + 0.95125,0.96347/ + DATA ( BM3I( 5, 5,IBETA ), IBETA = 1, 10 ) / + + 0.79614,0.80332,0.81957,0.84001,0.86190,0.88351,0.90368,0.92169, + + 0.93718,0.95006/ + DATA ( BM3I( 5, 6,IBETA ), IBETA = 1, 10 ) / + + 0.88192,0.88617,0.89565,0.90728,0.91931,0.93076,0.94107,0.94997, + + 0.95739,0.96333/ + DATA ( BM3I( 5, 7,IBETA ), IBETA = 1, 10 ) / + + 0.95509,0.95698,0.96105,0.96583,0.97048,0.97460,0.97796,0.98050, + + 0.98218,0.98304/ + DATA ( BM3I( 5, 8,IBETA ), IBETA = 1, 10 ) / + + 0.98596,0.98660,0.98794,0.98943,0.99074,0.99172,0.99227,0.99235, + + 0.99192,0.99096/ + DATA ( BM3I( 5, 9,IBETA ), IBETA = 1, 10 ) / + + 0.99581,0.99600,0.99637,0.99672,0.99691,0.99687,0.99653,0.99585, + + 0.99478,0.99329/ + DATA ( BM3I( 5,10,IBETA ), IBETA = 1, 10 ) / + + 0.99873,0.99878,0.99884,0.99883,0.99869,0.99834,0.99774,0.99684, + + 0.99558,0.99394/ + DATA ( BM3I( 6, 1,IBETA ), IBETA = 1, 10 ) / + + 0.93335,0.93777,0.94711,0.95764,0.96741,0.97562,0.98210,0.98701, + + 0.99064,0.99327/ + DATA ( BM3I( 6, 2,IBETA ), IBETA = 1, 10 ) / + + 0.92142,0.92646,0.93723,0.94947,0.96096,0.97069,0.97842,0.98431, + + 0.98868,0.99186/ + DATA ( BM3I( 6, 3,IBETA ), IBETA = 1, 10 ) / + + 0.88678,0.89351,0.90810,0.92508,0.94138,0.95549,0.96693,0.97578, + + 0.98243,0.98731/ + DATA ( BM3I( 6, 4,IBETA ), IBETA = 1, 10 ) / + + 0.83249,0.84124,0.86051,0.88357,0.90655,0.92728,0.94477,0.95880, + + 0.96964,0.97779/ + DATA ( BM3I( 6, 5,IBETA ), IBETA = 1, 10 ) / + + 0.79593,0.80444,0.82355,0.84725,0.87211,0.89593,0.91735,0.93566, + + 0.95066,0.96255/ + DATA ( BM3I( 6, 6,IBETA ), IBETA = 1, 10 ) / + + 0.84124,0.84695,0.85980,0.87575,0.89256,0.90885,0.92383,0.93704, + + 0.94830,0.95761/ + DATA ( BM3I( 6, 7,IBETA ), IBETA = 1, 10 ) / + + 0.92721,0.93011,0.93647,0.94406,0.95166,0.95862,0.96460,0.96949, + + 0.97326,0.97595/ + DATA ( BM3I( 6, 8,IBETA ), IBETA = 1, 10 ) / + + 0.97573,0.97681,0.97913,0.98175,0.98421,0.98624,0.98772,0.98860, + + 0.98885,0.98847/ + DATA ( BM3I( 6, 9,IBETA ), IBETA = 1, 10 ) / + + 0.99271,0.99304,0.99373,0.99444,0.99499,0.99528,0.99522,0.99477, + + 0.99390,0.99258/ + DATA ( BM3I( 6,10,IBETA ), IBETA = 1, 10 ) / + + 0.99782,0.99791,0.99807,0.99817,0.99813,0.99788,0.99737,0.99653, + + 0.99533,0.99374/ + DATA ( BM3I( 7, 1,IBETA ), IBETA = 1, 10 ) / + + 0.95858,0.96158,0.96780,0.97460,0.98073,0.98575,0.98963,0.99252, + + 0.99463,0.99615/ + DATA ( BM3I( 7, 2,IBETA ), IBETA = 1, 10 ) / + + 0.95091,0.95438,0.96163,0.96962,0.97688,0.98286,0.98751,0.99099, + + 0.99353,0.99536/ + DATA ( BM3I( 7, 3,IBETA ), IBETA = 1, 10 ) / + + 0.92751,0.93233,0.94255,0.95406,0.96473,0.97366,0.98070,0.98602, + + 0.98994,0.99278/ + DATA ( BM3I( 7, 4,IBETA ), IBETA = 1, 10 ) / + + 0.88371,0.89075,0.90595,0.92351,0.94028,0.95474,0.96642,0.97544, + + 0.98220,0.98715/ + DATA ( BM3I( 7, 5,IBETA ), IBETA = 1, 10 ) / + + 0.82880,0.83750,0.85671,0.87980,0.90297,0.92404,0.94195,0.95644, + + 0.96772,0.97625/ + DATA ( BM3I( 7, 6,IBETA ), IBETA = 1, 10 ) / + + 0.81933,0.82655,0.84279,0.86295,0.88412,0.90449,0.92295,0.93890, + + 0.95215,0.96281/ + DATA ( BM3I( 7, 7,IBETA ), IBETA = 1, 10 ) / + + 0.89099,0.89519,0.90448,0.91577,0.92732,0.93820,0.94789,0.95616, + + 0.96297,0.96838/ + DATA ( BM3I( 7, 8,IBETA ), IBETA = 1, 10 ) / + + 0.95886,0.96064,0.96448,0.96894,0.97324,0.97701,0.98004,0.98228, + + 0.98371,0.98435/ + DATA ( BM3I( 7, 9,IBETA ), IBETA = 1, 10 ) / + + 0.98727,0.98786,0.98908,0.99043,0.99160,0.99245,0.99288,0.99285, + + 0.99234,0.99131/ + DATA ( BM3I( 7,10,IBETA ), IBETA = 1, 10 ) / + + 0.99621,0.99638,0.99671,0.99700,0.99715,0.99707,0.99670,0.99599, + + 0.99489,0.99338/ + DATA ( BM3I( 8, 1,IBETA ), IBETA = 1, 10 ) / + + 0.97470,0.97666,0.98064,0.98491,0.98867,0.99169,0.99399,0.99569, + + 0.99691,0.99779/ + DATA ( BM3I( 8, 2,IBETA ), IBETA = 1, 10 ) / + + 0.96996,0.97225,0.97693,0.98196,0.98643,0.99003,0.99279,0.99482, + + 0.99630,0.99735/ + DATA ( BM3I( 8, 3,IBETA ), IBETA = 1, 10 ) / + + 0.95523,0.95848,0.96522,0.97260,0.97925,0.98468,0.98888,0.99200, + + 0.99427,0.99590/ + DATA ( BM3I( 8, 4,IBETA ), IBETA = 1, 10 ) / + + 0.92524,0.93030,0.94098,0.95294,0.96397,0.97317,0.98038,0.98582, + + 0.98981,0.99270/ + DATA ( BM3I( 8, 5,IBETA ), IBETA = 1, 10 ) / + + 0.87576,0.88323,0.89935,0.91799,0.93583,0.95126,0.96377,0.97345, + + 0.98072,0.98606/ + DATA ( BM3I( 8, 6,IBETA ), IBETA = 1, 10 ) / + + 0.83078,0.83894,0.85705,0.87899,0.90126,0.92179,0.93950,0.95404, + + 0.96551,0.97430/ + DATA ( BM3I( 8, 7,IBETA ), IBETA = 1, 10 ) / + + 0.85727,0.86294,0.87558,0.89111,0.90723,0.92260,0.93645,0.94841, + + 0.95838,0.96643/ + DATA ( BM3I( 8, 8,IBETA ), IBETA = 1, 10 ) / + + 0.93337,0.93615,0.94220,0.94937,0.95647,0.96292,0.96840,0.97283, + + 0.97619,0.97854/ + DATA ( BM3I( 8, 9,IBETA ), IBETA = 1, 10 ) / + + 0.97790,0.97891,0.98105,0.98346,0.98569,0.98751,0.98879,0.98950, + + 0.98961,0.98912/ + DATA ( BM3I( 8,10,IBETA ), IBETA = 1, 10 ) / + + 0.99337,0.99367,0.99430,0.99493,0.99541,0.99562,0.99551,0.99501, + + 0.99410,0.99274/ + DATA ( BM3I( 9, 1,IBETA ), IBETA = 1, 10 ) / + + 0.98470,0.98594,0.98844,0.99106,0.99334,0.99514,0.99650,0.99749, + + 0.99821,0.99872/ + DATA ( BM3I( 9, 2,IBETA ), IBETA = 1, 10 ) / + + 0.98184,0.98330,0.98624,0.98934,0.99205,0.99420,0.99582,0.99701, + + 0.99787,0.99848/ + DATA ( BM3I( 9, 3,IBETA ), IBETA = 1, 10 ) / + + 0.97288,0.97498,0.97927,0.98385,0.98789,0.99113,0.99360,0.99541, + + 0.99673,0.99766/ + DATA ( BM3I( 9, 4,IBETA ), IBETA = 1, 10 ) / + + 0.95403,0.95741,0.96440,0.97202,0.97887,0.98444,0.98872,0.99190, + + 0.99421,0.99586/ + DATA ( BM3I( 9, 5,IBETA ), IBETA = 1, 10 ) / + + 0.91845,0.92399,0.93567,0.94873,0.96076,0.97079,0.97865,0.98457, + + 0.98892,0.99206/ + DATA ( BM3I( 9, 6,IBETA ), IBETA = 1, 10 ) / + + 0.86762,0.87533,0.89202,0.91148,0.93027,0.94669,0.96013,0.97062, + + 0.97855,0.98441/ + DATA ( BM3I( 9, 7,IBETA ), IBETA = 1, 10 ) / + + 0.84550,0.85253,0.86816,0.88721,0.90671,0.92490,0.94083,0.95413, + + 0.96481,0.97314/ + DATA ( BM3I( 9, 8,IBETA ), IBETA = 1, 10 ) / + + 0.90138,0.90544,0.91437,0.92513,0.93602,0.94615,0.95506,0.96258, + + 0.96868,0.97347/ + DATA ( BM3I( 9, 9,IBETA ), IBETA = 1, 10 ) / + + 0.96248,0.96415,0.96773,0.97187,0.97583,0.97925,0.98198,0.98394, + + 0.98514,0.98559/ + DATA ( BM3I( 9,10,IBETA ), IBETA = 1, 10 ) / + + 0.98837,0.98892,0.99005,0.99127,0.99232,0.99306,0.99339,0.99328, + + 0.99269,0.99161/ + DATA ( BM3I( 10, 1,IBETA ), IBETA = 1, 10 ) / + + 0.99080,0.99158,0.99311,0.99471,0.99607,0.99715,0.99795,0.99853, + + 0.99895,0.99925/ + DATA ( BM3I( 10, 2,IBETA ), IBETA = 1, 10 ) / + + 0.98910,0.99001,0.99182,0.99371,0.99533,0.99661,0.99757,0.99826, + + 0.99876,0.99912/ + DATA ( BM3I( 10, 3,IBETA ), IBETA = 1, 10 ) / + + 0.98374,0.98506,0.98772,0.99051,0.99294,0.99486,0.99630,0.99736, + + 0.99812,0.99866/ + DATA ( BM3I( 10, 4,IBETA ), IBETA = 1, 10 ) / + + 0.97238,0.97453,0.97892,0.98361,0.98773,0.99104,0.99354,0.99538, + + 0.99671,0.99765/ + DATA ( BM3I( 10, 5,IBETA ), IBETA = 1, 10 ) / + + 0.94961,0.95333,0.96103,0.96941,0.97693,0.98303,0.98772,0.99119, + + 0.99371,0.99551/ + DATA ( BM3I( 10, 6,IBETA ), IBETA = 1, 10 ) / + + 0.90943,0.91550,0.92834,0.94275,0.95608,0.96723,0.97600,0.98263, + + 0.98751,0.99103/ + DATA ( BM3I( 10, 7,IBETA ), IBETA = 1, 10 ) / + + 0.86454,0.87200,0.88829,0.90749,0.92630,0.94300,0.95687,0.96785, + + 0.97626,0.98254/ + DATA ( BM3I( 10, 8,IBETA ), IBETA = 1, 10 ) / + + 0.87498,0.88048,0.89264,0.90737,0.92240,0.93642,0.94877,0.95917, + + 0.96762,0.97429/ + DATA ( BM3I( 10, 9,IBETA ), IBETA = 1, 10 ) / + + 0.93946,0.94209,0.94781,0.95452,0.96111,0.96704,0.97203,0.97602, + + 0.97900,0.98106/ + DATA ( BM3I( 10,10,IBETA ), IBETA = 1, 10 ) / + + 0.97977,0.98071,0.98270,0.98492,0.98695,0.98858,0.98970,0.99027, + + 0.99026,0.98968/ + +C FSB FM correction for INTRAmodal M2 coagulation + DATA BM2II / + & 0.707107, 0.720583, 0.745310, 0.748056, 0.696935, + & 0.604164, 0.504622, 0.416559, 0.343394, 0.283641/ + +C *** total correction for INTRAmodal M2 coagulation + DATA BM2IITT / + & 1.000000, 0.907452, 0.680931, 0.409815, 0.196425, + & 0.078814, 0.028473, 0.009800, 0.003322, 0.001129/ + +C FSB FM correction for M2 i to j coagulation + DATA ( BM2IJ( 1, 1,IBETA ), IBETA = 1, 10 ) / + & 0.707107, 0.716828, 0.738240, 0.764827, 0.793610, + & 0.822843, 0.851217, 0.877670, 0.901404, 0.921944/ + DATA ( BM2IJ( 1, 2,IBETA ), IBETA = 1, 10 ) / + & 0.719180, 0.727975, 0.747638, 0.772334, 0.799234, + & 0.826666, 0.853406, 0.878482, 0.901162, 0.920987/ + DATA ( BM2IJ( 1, 3,IBETA ), IBETA = 1, 10 ) / + & 0.760947, 0.767874, 0.783692, 0.803890, 0.826015, + & 0.848562, 0.870498, 0.891088, 0.909823, 0.926400/ + DATA ( BM2IJ( 1, 4,IBETA ), IBETA = 1, 10 ) / + & 0.830926, 0.836034, 0.847708, 0.862528, 0.878521, + & 0.894467, 0.909615, 0.923520, 0.935959, 0.946858/ + DATA ( BM2IJ( 1, 5,IBETA ), IBETA = 1, 10 ) / + & 0.903643, 0.907035, 0.914641, 0.924017, 0.933795, + & 0.943194, 0.951806, 0.959449, 0.966087, 0.971761/ + DATA ( BM2IJ( 1, 6,IBETA ), IBETA = 1, 10 ) / + & 0.954216, 0.956094, 0.960211, 0.965123, 0.970068, + & 0.974666, 0.978750, 0.982277, 0.985268, 0.987775/ + DATA ( BM2IJ( 1, 7,IBETA ), IBETA = 1, 10 ) / + & 0.980546, 0.981433, 0.983343, 0.985568, 0.987751, + & 0.989735, 0.991461, 0.992926, 0.994150, 0.995164/ + DATA ( BM2IJ( 1, 8,IBETA ), IBETA = 1, 10 ) / + & 0.992142, 0.992524, 0.993338, 0.994272, 0.995174, + & 0.995981, 0.996675, 0.997257, 0.997740, 0.998137/ + DATA ( BM2IJ( 1, 9,IBETA ), IBETA = 1, 10 ) / + & 0.996868, 0.997026, 0.997361, 0.997742, 0.998106, + & 0.998430, 0.998705, 0.998935, 0.999125, 0.999280/ + DATA ( BM2IJ( 1, 10,IBETA ), IBETA = 1, 10 ) / + & 0.998737, 0.998802, 0.998939, 0.999094, 0.999241, + & 0.999371, 0.999481, 0.999573, 0.999648, 0.999709/ + DATA ( BM2IJ( 2, 1,IBETA ), IBETA = 1, 10 ) / + & 0.729600, 0.739948, 0.763059, 0.791817, 0.822510, + & 0.852795, 0.881000, 0.905999, 0.927206, 0.944532/ + DATA ( BM2IJ( 2, 2,IBETA ), IBETA = 1, 10 ) / + & 0.727025, 0.737116, 0.759615, 0.787657, 0.817740, + & 0.847656, 0.875801, 0.901038, 0.922715, 0.940643/ + DATA ( BM2IJ( 2, 3,IBETA ), IBETA = 1, 10 ) / + & 0.738035, 0.746779, 0.766484, 0.791340, 0.818324, + & 0.845546, 0.871629, 0.895554, 0.916649, 0.934597/ + DATA ( BM2IJ( 2, 4,IBETA ), IBETA = 1, 10 ) / + & 0.784185, 0.790883, 0.806132, 0.825501, 0.846545, + & 0.867745, 0.888085, 0.906881, 0.923705, 0.938349/ + DATA ( BM2IJ( 2, 5,IBETA ), IBETA = 1, 10 ) / + & 0.857879, 0.862591, 0.873238, 0.886539, 0.900645, + & 0.914463, 0.927360, 0.939004, 0.949261, 0.958125/ + DATA ( BM2IJ( 2, 6,IBETA ), IBETA = 1, 10 ) / + & 0.925441, 0.928304, 0.934645, 0.942324, 0.950181, + & 0.957600, 0.964285, 0.970133, 0.975147, 0.979388/ + DATA ( BM2IJ( 2, 7,IBETA ), IBETA = 1, 10 ) / + & 0.966728, 0.968176, 0.971323, 0.975027, 0.978705, + & 0.982080, 0.985044, 0.987578, 0.989710, 0.991485/ + DATA ( BM2IJ( 2, 8,IBETA ), IBETA = 1, 10 ) / + & 0.986335, 0.986980, 0.988362, 0.989958, 0.991511, + & 0.992912, 0.994122, 0.995143, 0.995992, 0.996693/ + DATA ( BM2IJ( 2, 9,IBETA ), IBETA = 1, 10 ) / + & 0.994547, 0.994817, 0.995391, 0.996046, 0.996677, + & 0.997238, 0.997719, 0.998122, 0.998454, 0.998727/ + DATA ( BM2IJ( 2, 10,IBETA ), IBETA = 1, 10 ) / + & 0.997817, 0.997928, 0.998163, 0.998429, 0.998683, + & 0.998908, 0.999099, 0.999258, 0.999389, 0.999497/ + DATA ( BM2IJ( 3, 1,IBETA ), IBETA = 1, 10 ) / + & 0.783612, 0.793055, 0.814468, 0.841073, 0.868769, + & 0.894963, 0.918118, 0.937527, 0.953121, 0.965244/ + DATA ( BM2IJ( 3, 2,IBETA ), IBETA = 1, 10 ) / + & 0.772083, 0.781870, 0.803911, 0.831238, 0.859802, + & 0.887036, 0.911349, 0.931941, 0.948649, 0.961751/ + DATA ( BM2IJ( 3, 3,IBETA ), IBETA = 1, 10 ) / + & 0.755766, 0.765509, 0.787380, 0.814630, 0.843526, + & 0.871670, 0.897443, 0.919870, 0.938557, 0.953576/ + DATA ( BM2IJ( 3, 4,IBETA ), IBETA = 1, 10 ) / + & 0.763816, 0.772145, 0.790997, 0.814784, 0.840434, + & 0.865978, 0.890034, 0.911671, 0.930366, 0.945963/ + DATA ( BM2IJ( 3, 5,IBETA ), IBETA = 1, 10 ) / + & 0.813597, 0.819809, 0.833889, 0.851618, 0.870640, + & 0.889514, 0.907326, 0.923510, 0.937768, 0.950003/ + DATA ( BM2IJ( 3, 6,IBETA ), IBETA = 1, 10 ) / + & 0.886317, 0.890437, 0.899643, 0.910955, 0.922730, + & 0.934048, 0.944422, 0.953632, 0.961624, 0.968444/ + DATA ( BM2IJ( 3, 7,IBETA ), IBETA = 1, 10 ) / + & 0.944565, 0.946855, 0.951872, 0.957854, 0.963873, + & 0.969468, 0.974438, 0.978731, 0.982372, 0.985424/ + DATA ( BM2IJ( 3, 8,IBETA ), IBETA = 1, 10 ) / + & 0.976358, 0.977435, 0.979759, 0.982467, 0.985125, + & 0.987540, 0.989642, 0.991425, 0.992916, 0.994150/ + DATA ( BM2IJ( 3, 9,IBETA ), IBETA = 1, 10 ) / + & 0.990471, 0.990932, 0.991917, 0.993048, 0.994142, + & 0.995121, 0.995964, 0.996671, 0.997258, 0.997740/ + DATA ( BM2IJ( 3, 10,IBETA ), IBETA = 1, 10 ) / + & 0.996199, 0.996389, 0.996794, 0.997254, 0.997694, + & 0.998086, 0.998420, 0.998699, 0.998929, 0.999117/ + DATA ( BM2IJ( 4, 1,IBETA ), IBETA = 1, 10 ) / + & 0.844355, 0.852251, 0.869914, 0.891330, 0.912823, + & 0.932259, 0.948642, 0.961767, 0.971897, 0.979510/ + DATA ( BM2IJ( 4, 2,IBETA ), IBETA = 1, 10 ) / + & 0.831550, 0.839954, 0.858754, 0.881583, 0.904592, + & 0.925533, 0.943309, 0.957647, 0.968779, 0.977185/ + DATA ( BM2IJ( 4, 3,IBETA ), IBETA = 1, 10 ) / + & 0.803981, 0.813288, 0.834060, 0.859400, 0.885285, + & 0.909286, 0.930084, 0.947193, 0.960714, 0.971078/ + DATA ( BM2IJ( 4, 4,IBETA ), IBETA = 1, 10 ) / + & 0.781787, 0.791080, 0.811931, 0.837749, 0.864768, + & 0.890603, 0.913761, 0.933477, 0.949567, 0.962261/ + DATA ( BM2IJ( 4, 5,IBETA ), IBETA = 1, 10 ) / + & 0.791591, 0.799355, 0.816916, 0.838961, 0.862492, + & 0.885595, 0.907003, 0.925942, 0.942052, 0.955310/ + DATA ( BM2IJ( 4, 6,IBETA ), IBETA = 1, 10 ) / + & 0.844933, 0.850499, 0.863022, 0.878593, 0.895038, + & 0.911072, 0.925939, 0.939227, 0.950765, 0.960550/ + DATA ( BM2IJ( 4, 7,IBETA ), IBETA = 1, 10 ) / + & 0.912591, 0.916022, 0.923607, 0.932777, 0.942151, + & 0.951001, 0.958976, 0.965950, 0.971924, 0.976965/ + DATA ( BM2IJ( 4, 8,IBETA ), IBETA = 1, 10 ) / + & 0.959859, 0.961617, 0.965433, 0.969924, 0.974382, + & 0.978472, 0.982063, 0.985134, 0.987716, 0.989865/ + DATA ( BM2IJ( 4, 9,IBETA ), IBETA = 1, 10 ) / + & 0.983377, 0.984162, 0.985844, 0.987788, 0.989681, + & 0.991386, 0.992860, 0.994104, 0.995139, 0.995991/ + DATA ( BM2IJ( 4, 10,IBETA ), IBETA = 1, 10 ) / + & 0.993343, 0.993672, 0.994370, 0.995169, 0.995937, + & 0.996622, 0.997209, 0.997700, 0.998106, 0.998439/ + DATA ( BM2IJ( 5, 1,IBETA ), IBETA = 1, 10 ) / + & 0.895806, 0.901918, 0.915233, 0.930783, 0.945768, + & 0.958781, 0.969347, 0.977540, 0.983697, 0.988225/ + DATA ( BM2IJ( 5, 2,IBETA ), IBETA = 1, 10 ) / + & 0.885634, 0.892221, 0.906629, 0.923540, 0.939918, + & 0.954213, 0.965873, 0.974951, 0.981794, 0.986840/ + DATA ( BM2IJ( 5, 3,IBETA ), IBETA = 1, 10 ) / + & 0.860120, 0.867858, 0.884865, 0.904996, 0.924724, + & 0.942177, 0.956602, 0.967966, 0.976616, 0.983043/ + DATA ( BM2IJ( 5, 4,IBETA ), IBETA = 1, 10 ) / + & 0.827462, 0.836317, 0.855885, 0.879377, 0.902897, + & 0.924232, 0.942318, 0.956900, 0.968222, 0.976774/ + DATA ( BM2IJ( 5, 5,IBETA ), IBETA = 1, 10 ) / + & 0.805527, 0.814279, 0.833853, 0.857892, 0.882726, + & 0.906095, 0.926690, 0.943938, 0.957808, 0.968615/ + DATA ( BM2IJ( 5, 6,IBETA ), IBETA = 1, 10 ) / + & 0.820143, 0.827223, 0.843166, 0.863002, 0.883905, + & 0.904128, 0.922585, 0.938687, 0.952222, 0.963255/ + DATA ( BM2IJ( 5, 7,IBETA ), IBETA = 1, 10 ) / + & 0.875399, 0.880208, 0.890929, 0.904065, 0.917699, + & 0.930756, 0.942656, 0.953131, 0.962113, 0.969657/ + DATA ( BM2IJ( 5, 8,IBETA ), IBETA = 1, 10 ) / + & 0.934782, 0.937520, 0.943515, 0.950656, 0.957840, + & 0.964516, 0.970446, 0.975566, 0.979905, 0.983534/ + DATA ( BM2IJ( 5, 9,IBETA ), IBETA = 1, 10 ) / + & 0.971369, 0.972679, 0.975505, 0.978797, 0.982029, + & 0.984964, 0.987518, 0.989685, 0.991496, 0.992994/ + DATA ( BM2IJ( 5, 10,IBETA ), IBETA = 1, 10 ) / + & 0.988329, 0.988893, 0.990099, 0.991485, 0.992825, + & 0.994025, 0.995058, 0.995925, 0.996643, 0.997234/ + DATA ( BM2IJ( 6, 1,IBETA ), IBETA = 1, 10 ) / + & 0.933384, 0.937784, 0.947130, 0.957655, 0.967430, + & 0.975639, 0.982119, 0.987031, 0.990657, 0.993288/ + DATA ( BM2IJ( 6, 2,IBETA ), IBETA = 1, 10 ) / + & 0.926445, 0.931227, 0.941426, 0.952975, 0.963754, + & 0.972845, 0.980044, 0.985514, 0.989558, 0.992498/ + DATA ( BM2IJ( 6, 3,IBETA ), IBETA = 1, 10 ) / + & 0.907835, 0.913621, 0.926064, 0.940308, 0.953745, + & 0.965189, 0.974327, 0.981316, 0.986510, 0.990297/ + DATA ( BM2IJ( 6, 4,IBETA ), IBETA = 1, 10 ) / + & 0.879088, 0.886306, 0.901945, 0.920079, 0.937460, + & 0.952509, 0.964711, 0.974166, 0.981265, 0.986484/ + DATA ( BM2IJ( 6, 5,IBETA ), IBETA = 1, 10 ) / + & 0.846500, 0.854862, 0.873189, 0.894891, 0.916264, + & 0.935315, 0.951197, 0.963812, 0.973484, 0.980715/ + DATA ( BM2IJ( 6, 6,IBETA ), IBETA = 1, 10 ) / + & 0.828137, 0.836250, 0.854310, 0.876287, 0.898710, + & 0.919518, 0.937603, 0.952560, 0.964461, 0.973656/ + DATA ( BM2IJ( 6, 7,IBETA ), IBETA = 1, 10 ) / + & 0.848595, 0.854886, 0.868957, 0.886262, 0.904241, + & 0.921376, 0.936799, 0.950096, 0.961172, 0.970145/ + DATA ( BM2IJ( 6, 8,IBETA ), IBETA = 1, 10 ) / + & 0.902919, 0.906922, 0.915760, 0.926427, 0.937312, + & 0.947561, 0.956758, 0.964747, 0.971525, 0.977175/ + DATA ( BM2IJ( 6, 9,IBETA ), IBETA = 1, 10 ) / + & 0.952320, 0.954434, 0.959021, 0.964418, 0.969774, + & 0.974688, 0.979003, 0.982690, 0.985789, 0.988364/ + DATA ( BM2IJ( 6, 10,IBETA ), IBETA = 1, 10 ) / + & 0.979689, 0.980650, 0.982712, 0.985093, 0.987413, + & 0.989502, 0.991308, 0.992831, 0.994098, 0.995142/ + DATA ( BM2IJ( 7, 1,IBETA ), IBETA = 1, 10 ) / + & 0.958611, 0.961598, 0.967817, 0.974620, 0.980752, + & 0.985771, 0.989650, 0.992543, 0.994653, 0.996171/ + DATA ( BM2IJ( 7, 2,IBETA ), IBETA = 1, 10 ) / + & 0.954225, 0.957488, 0.964305, 0.971795, 0.978576, + & 0.984144, 0.988458, 0.991681, 0.994034, 0.995728/ + DATA ( BM2IJ( 7, 3,IBETA ), IBETA = 1, 10 ) / + & 0.942147, 0.946158, 0.954599, 0.963967, 0.972529, + & 0.979612, 0.985131, 0.989271, 0.992301, 0.994487/ + DATA ( BM2IJ( 7, 4,IBETA ), IBETA = 1, 10 ) / + & 0.921821, 0.927048, 0.938140, 0.950598, 0.962118, + & 0.971752, 0.979326, 0.985046, 0.989254, 0.992299/ + DATA ( BM2IJ( 7, 5,IBETA ), IBETA = 1, 10 ) / + & 0.893419, 0.900158, 0.914598, 0.931070, 0.946584, + & 0.959795, 0.970350, 0.978427, 0.984432, 0.988811/ + DATA ( BM2IJ( 7, 6,IBETA ), IBETA = 1, 10 ) / + & 0.863302, 0.871111, 0.888103, 0.907990, 0.927305, + & 0.944279, 0.958245, 0.969211, 0.977540, 0.983720/ + DATA ( BM2IJ( 7, 7,IBETA ), IBETA = 1, 10 ) / + & 0.850182, 0.857560, 0.873890, 0.893568, 0.913408, + & 0.931591, 0.947216, 0.960014, 0.970121, 0.977886/ + DATA ( BM2IJ( 7, 8,IBETA ), IBETA = 1, 10 ) / + & 0.875837, 0.881265, 0.893310, 0.907936, 0.922910, + & 0.936977, 0.949480, 0.960154, 0.968985, 0.976111/ + DATA ( BM2IJ( 7, 9,IBETA ), IBETA = 1, 10 ) / + & 0.926228, 0.929445, 0.936486, 0.944868, 0.953293, + & 0.961108, 0.968028, 0.973973, 0.978974, 0.983118/ + DATA ( BM2IJ( 7, 10,IBETA ), IBETA = 1, 10 ) / + & 0.965533, 0.967125, 0.970558, 0.974557, 0.978484, + & 0.982050, 0.985153, 0.987785, 0.989982, 0.991798/ + DATA ( BM2IJ( 8, 1,IBETA ), IBETA = 1, 10 ) / + & 0.974731, 0.976674, 0.980660, 0.984926, 0.988689, + & 0.991710, 0.994009, 0.995703, 0.996929, 0.997805/ + DATA ( BM2IJ( 8, 2,IBETA ), IBETA = 1, 10 ) / + & 0.972062, 0.974192, 0.978571, 0.983273, 0.987432, + & 0.990780, 0.993333, 0.995218, 0.996581, 0.997557/ + DATA ( BM2IJ( 8, 3,IBETA ), IBETA = 1, 10 ) / + & 0.964662, 0.967300, 0.972755, 0.978659, 0.983921, + & 0.988181, 0.991444, 0.993859, 0.995610, 0.996863/ + DATA ( BM2IJ( 8, 4,IBETA ), IBETA = 1, 10 ) / + & 0.951782, 0.955284, 0.962581, 0.970559, 0.977737, + & 0.983593, 0.988103, 0.991454, 0.993889, 0.995635/ + DATA ( BM2IJ( 8, 5,IBETA ), IBETA = 1, 10 ) / + & 0.931947, 0.936723, 0.946751, 0.957843, 0.967942, + & 0.976267, 0.982734, 0.987571, 0.991102, 0.993642/ + DATA ( BM2IJ( 8, 6,IBETA ), IBETA = 1, 10 ) / + & 0.905410, 0.911665, 0.924950, 0.939908, 0.953798, + & 0.965469, 0.974684, 0.981669, 0.986821, 0.990556/ + DATA ( BM2IJ( 8, 7,IBETA ), IBETA = 1, 10 ) / + & 0.878941, 0.886132, 0.901679, 0.919688, 0.936970, + & 0.951980, 0.964199, 0.973709, 0.980881, 0.986174/ + DATA ( BM2IJ( 8, 8,IBETA ), IBETA = 1, 10 ) / + & 0.871653, 0.878218, 0.892652, 0.909871, 0.927034, + & 0.942592, 0.955836, 0.966604, 0.975065, 0.981545/ + DATA ( BM2IJ( 8, 9,IBETA ), IBETA = 1, 10 ) / + & 0.900693, 0.905239, 0.915242, 0.927232, 0.939335, + & 0.950555, 0.960420, 0.968774, 0.975651, 0.981188/ + DATA ( BM2IJ( 8, 10,IBETA ), IBETA = 1, 10 ) / + & 0.944922, 0.947435, 0.952894, 0.959317, 0.965689, + & 0.971529, 0.976645, 0.981001, 0.984641, 0.987642/ + DATA ( BM2IJ( 9, 1,IBETA ), IBETA = 1, 10 ) / + & 0.984736, 0.985963, 0.988453, 0.991078, 0.993357, + & 0.995161, 0.996519, 0.997512, 0.998226, 0.998734/ + DATA ( BM2IJ( 9, 2,IBETA ), IBETA = 1, 10 ) / + & 0.983141, 0.984488, 0.987227, 0.990119, 0.992636, + & 0.994632, 0.996137, 0.997238, 0.998030, 0.998595/ + DATA ( BM2IJ( 9, 3,IBETA ), IBETA = 1, 10 ) / + & 0.978726, 0.980401, 0.983819, 0.987450, 0.990626, + & 0.993157, 0.995071, 0.996475, 0.997486, 0.998206/ + DATA ( BM2IJ( 9, 4,IBETA ), IBETA = 1, 10 ) / + & 0.970986, 0.973224, 0.977818, 0.982737, 0.987072, + & 0.990546, 0.993184, 0.995124, 0.996523, 0.997521/ + DATA ( BM2IJ( 9, 5,IBETA ), IBETA = 1, 10 ) / + & 0.958579, 0.961700, 0.968149, 0.975116, 0.981307, + & 0.986301, 0.990112, 0.992923, 0.994954, 0.996404/ + DATA ( BM2IJ( 9, 6,IBETA ), IBETA = 1, 10 ) / + & 0.940111, 0.944479, 0.953572, 0.963506, 0.972436, + & 0.979714, 0.985313, 0.989468, 0.992483, 0.994641/ + DATA ( BM2IJ( 9, 7,IBETA ), IBETA = 1, 10 ) / + & 0.916127, 0.921878, 0.934003, 0.947506, 0.959899, + & 0.970199, 0.978255, 0.984314, 0.988755, 0.991960/ + DATA ( BM2IJ( 9, 8,IBETA ), IBETA = 1, 10 ) / + & 0.893848, 0.900364, 0.914368, 0.930438, 0.945700, + & 0.958824, 0.969416, 0.977603, 0.983746, 0.988262/ + DATA ( BM2IJ( 9, 9,IBETA ), IBETA = 1, 10 ) / + & 0.892161, 0.897863, 0.910315, 0.925021, 0.939523, + & 0.952544, 0.963544, 0.972442, 0.979411, 0.984742/ + DATA ( BM2IJ( 9, 10,IBETA ), IBETA = 1, 10 ) / + & 0.922260, 0.925966, 0.934047, 0.943616, 0.953152, + & 0.961893, 0.969506, 0.975912, 0.981167, 0.985394/ + DATA ( BM2IJ( 10, 1,IBETA ), IBETA = 1, 10 ) / + & 0.990838, 0.991598, 0.993128, 0.994723, 0.996092, + & 0.997167, 0.997969, 0.998552, 0.998969, 0.999265/ + DATA ( BM2IJ( 10, 2,IBETA ), IBETA = 1, 10 ) / + & 0.989892, 0.990727, 0.992411, 0.994167, 0.995678, + & 0.996864, 0.997751, 0.998396, 0.998858, 0.999186/ + DATA ( BM2IJ( 10, 3,IBETA ), IBETA = 1, 10 ) / + & 0.987287, 0.988327, 0.990428, 0.992629, 0.994529, + & 0.996026, 0.997148, 0.997965, 0.998551, 0.998967/ + DATA ( BM2IJ( 10, 4,IBETA ), IBETA = 1, 10 ) / + & 0.982740, 0.984130, 0.986952, 0.989926, 0.992508, + & 0.994551, 0.996087, 0.997208, 0.998012, 0.998584/ + DATA ( BM2IJ( 10, 5,IBETA ), IBETA = 1, 10 ) / + & 0.975380, 0.977330, 0.981307, 0.985529, 0.989216, + & 0.992147, 0.994358, 0.995975, 0.997136, 0.997961/ + DATA ( BM2IJ( 10, 6,IBETA ), IBETA = 1, 10 ) / + & 0.963911, 0.966714, 0.972465, 0.978614, 0.984022, + & 0.988346, 0.991620, 0.994020, 0.995747, 0.996974/ + DATA ( BM2IJ( 10, 7,IBETA ), IBETA = 1, 10 ) / + & 0.947187, 0.951161, 0.959375, 0.968258, 0.976160, + & 0.982540, 0.987409, 0.991000, 0.993592, 0.995441/ + DATA ( BM2IJ( 10, 8,IBETA ), IBETA = 1, 10 ) / + & 0.926045, 0.931270, 0.942218, 0.954297, 0.965273, + & 0.974311, 0.981326, 0.986569, 0.990394, 0.993143/ + DATA ( BM2IJ( 10, 9,IBETA ), IBETA = 1, 10 ) / + & 0.908092, 0.913891, 0.926288, 0.940393, 0.953667, + & 0.964987, 0.974061, 0.981038, 0.986253, 0.990078/ + DATA ( BM2IJ( 10, 10,IBETA ), IBETA = 1, 10 ) / + & 0.911143, 0.915972, 0.926455, 0.938721, 0.950701, + & 0.961370, 0.970329, 0.977549, 0.983197, 0.987518/ + +C FSB Total correction factor for M2 coagulation j from i + + DATA ( BM2JI( 1, 1,IBETA ), IBETA = 1, 10 ) / + & 0.753466, 0.756888, 0.761008, 0.759432, 0.748675, + & 0.726951, 0.693964, 0.650915, 0.600227, 0.545000/ + DATA ( BM2JI( 1, 2,IBETA ), IBETA = 1, 10 ) / + & 0.824078, 0.828698, 0.835988, 0.838943, 0.833454, + & 0.817148, 0.789149, 0.750088, 0.701887, 0.647308/ + DATA ( BM2JI( 1, 3,IBETA ), IBETA = 1, 10 ) / + & 1.007389, 1.014362, 1.028151, 1.041011, 1.047939, + & 1.045707, 1.032524, 1.007903, 0.972463, 0.927667/ + DATA ( BM2JI( 1, 4,IBETA ), IBETA = 1, 10 ) / + & 1.246157, 1.255135, 1.274249, 1.295351, 1.313362, + & 1.325187, 1.329136, 1.324491, 1.311164, 1.289459/ + DATA ( BM2JI( 1, 5,IBETA ), IBETA = 1, 10 ) / + & 1.450823, 1.459551, 1.478182, 1.499143, 1.518224, + & 1.533312, 1.543577, 1.548882, 1.549395, 1.545364/ + DATA ( BM2JI( 1, 6,IBETA ), IBETA = 1, 10 ) / + & 1.575248, 1.581832, 1.595643, 1.610866, 1.624601, + & 1.635690, 1.643913, 1.649470, 1.652688, 1.653878/ + DATA ( BM2JI( 1, 7,IBETA ), IBETA = 1, 10 ) / + & 1.638426, 1.642626, 1.651293, 1.660641, 1.668926, + & 1.675571, 1.680572, 1.684147, 1.686561, 1.688047/ + DATA ( BM2JI( 1, 8,IBETA ), IBETA = 1, 10 ) / + & 1.669996, 1.672392, 1.677283, 1.682480, 1.687028, + & 1.690651, 1.693384, 1.695372, 1.696776, 1.697734/ + DATA ( BM2JI( 1, 9,IBETA ), IBETA = 1, 10 ) / + & 1.686148, 1.687419, 1.689993, 1.692704, 1.695057, + & 1.696922, 1.698329, 1.699359, 1.700099, 1.700621/ + DATA ( BM2JI( 1,10,IBETA ), IBETA = 1, 10 ) / + & 1.694364, 1.695010, 1.696313, 1.697676, 1.698853, + & 1.699782, 1.700482, 1.700996, 1.701366, 1.701631/ + DATA ( BM2JI( 2, 1,IBETA ), IBETA = 1, 10 ) / + & 0.783166, 0.779369, 0.768044, 0.747572, 0.716709, + & 0.675422, 0.624981, 0.567811, 0.507057, 0.445975/ + DATA ( BM2JI( 2, 2,IBETA ), IBETA = 1, 10 ) / + & 0.848390, 0.847100, 0.840874, 0.826065, 0.800296, + & 0.762625, 0.713655, 0.655545, 0.591603, 0.525571/ + DATA ( BM2JI( 2, 3,IBETA ), IBETA = 1, 10 ) / + & 1.039894, 1.043786, 1.049445, 1.049664, 1.039407, + & 1.015322, 0.975983, 0.922180, 0.856713, 0.783634/ + DATA ( BM2JI( 2, 4,IBETA ), IBETA = 1, 10 ) / + & 1.345995, 1.356064, 1.376947, 1.398304, 1.412685, + & 1.414611, 1.400652, 1.369595, 1.322261, 1.260993/ + DATA ( BM2JI( 2, 5,IBETA ), IBETA = 1, 10 ) / + & 1.675575, 1.689859, 1.720957, 1.756659, 1.788976, + & 1.812679, 1.824773, 1.824024, 1.810412, 1.784630/ + DATA ( BM2JI( 2, 6,IBETA ), IBETA = 1, 10 ) / + & 1.919835, 1.933483, 1.962973, 1.996810, 2.028377, + & 2.054172, 2.072763, 2.083963, 2.088190, 2.086052/ + DATA ( BM2JI( 2, 7,IBETA ), IBETA = 1, 10 ) / + & 2.064139, 2.074105, 2.095233, 2.118909, 2.140688, + & 2.158661, 2.172373, 2.182087, 2.188330, 2.191650/ + DATA ( BM2JI( 2, 8,IBETA ), IBETA = 1, 10 ) / + & 2.144871, 2.150990, 2.163748, 2.177731, 2.190364, + & 2.200712, 2.208687, 2.214563, 2.218716, 2.221502/ + DATA ( BM2JI( 2, 9,IBETA ), IBETA = 1, 10 ) / + & 2.189223, 2.192595, 2.199540, 2.207033, 2.213706, + & 2.219125, 2.223297, 2.226403, 2.228660, 2.230265/ + DATA ( BM2JI( 2,10,IBETA ), IBETA = 1, 10 ) / + & 2.212595, 2.214342, 2.217912, 2.221723, 2.225082, + & 2.227791, 2.229869, 2.231417, 2.232551, 2.233372/ + DATA ( BM2JI( 3, 1,IBETA ), IBETA = 1, 10 ) / + & 0.837870, 0.824476, 0.793119, 0.750739, 0.700950, + & 0.646691, 0.590508, 0.534354, 0.479532, 0.426856/ + DATA ( BM2JI( 3, 2,IBETA ), IBETA = 1, 10 ) / + & 0.896771, 0.885847, 0.859327, 0.821694, 0.775312, + & 0.722402, 0.665196, 0.605731, 0.545742, 0.486687/ + DATA ( BM2JI( 3, 3,IBETA ), IBETA = 1, 10 ) / + & 1.076089, 1.071727, 1.058845, 1.036171, 1.002539, + & 0.957521, 0.901640, 0.836481, 0.764597, 0.689151/ + DATA ( BM2JI( 3, 4,IBETA ), IBETA = 1, 10 ) / + & 1.409571, 1.415168, 1.425346, 1.432021, 1.428632, + & 1.409696, 1.371485, 1.312958, 1.236092, 1.145293/ + DATA ( BM2JI( 3, 5,IBETA ), IBETA = 1, 10 ) / + & 1.862757, 1.880031, 1.918394, 1.963456, 2.004070, + & 2.030730, 2.036144, 2.016159, 1.970059, 1.900079/ + DATA ( BM2JI( 3, 6,IBETA ), IBETA = 1, 10 ) / + & 2.289741, 2.313465, 2.366789, 2.431612, 2.495597, + & 2.549838, 2.588523, 2.608665, 2.609488, 2.591662/ + DATA ( BM2JI( 3, 7,IBETA ), IBETA = 1, 10 ) / + & 2.597157, 2.618731, 2.666255, 2.722597, 2.777531, + & 2.825187, 2.862794, 2.889648, 2.906199, 2.913380/ + DATA ( BM2JI( 3, 8,IBETA ), IBETA = 1, 10 ) / + & 2.797975, 2.813116, 2.845666, 2.882976, 2.918289, + & 2.948461, 2.972524, 2.990687, 3.003664, 3.012284/ + DATA ( BM2JI( 3, 9,IBETA ), IBETA = 1, 10 ) / + & 2.920832, 2.929843, 2.948848, 2.970057, 2.989632, + & 3.006057, 3.019067, 3.028979, 3.036307, 3.041574/ + DATA ( BM2JI( 3,10,IBETA ), IBETA = 1, 10 ) / + & 2.989627, 2.994491, 3.004620, 3.015720, 3.025789, + & 3.034121, 3.040664, 3.045641, 3.049347, 3.052066/ + DATA ( BM2JI( 4, 1,IBETA ), IBETA = 1, 10 ) / + & 0.893179, 0.870897, 0.820996, 0.759486, 0.695488, + & 0.634582, 0.579818, 0.532143, 0.490927, 0.454618/ + DATA ( BM2JI( 4, 2,IBETA ), IBETA = 1, 10 ) / + & 0.948355, 0.927427, 0.880215, 0.821146, 0.758524, + & 0.697680, 0.641689, 0.591605, 0.546919, 0.506208/ + DATA ( BM2JI( 4, 3,IBETA ), IBETA = 1, 10 ) / + & 1.109562, 1.093648, 1.056438, 1.007310, 0.951960, + & 0.894453, 0.837364, 0.781742, 0.727415, 0.673614/ + DATA ( BM2JI( 4, 4,IBETA ), IBETA = 1, 10 ) / + & 1.423321, 1.417557, 1.402442, 1.379079, 1.347687, + & 1.308075, 1.259703, 1.201983, 1.134778, 1.058878/ + DATA ( BM2JI( 4, 5,IBETA ), IBETA = 1, 10 ) / + & 1.933434, 1.944347, 1.968765, 1.997653, 2.023054, + & 2.036554, 2.029949, 1.996982, 1.934982, 1.845473/ + DATA ( BM2JI( 4, 6,IBETA ), IBETA = 1, 10 ) / + & 2.547772, 2.577105, 2.645918, 2.735407, 2.830691, + & 2.917268, 2.981724, 3.013684, 3.007302, 2.961560/ + DATA ( BM2JI( 4, 7,IBETA ), IBETA = 1, 10 ) / + & 3.101817, 3.139271, 3.225851, 3.336402, 3.453409, + & 3.563116, 3.655406, 3.724014, 3.766113, 3.781394/ + DATA ( BM2JI( 4, 8,IBETA ), IBETA = 1, 10 ) / + & 3.540920, 3.573780, 3.647439, 3.737365, 3.828468, + & 3.911436, 3.981317, 4.036345, 4.076749, 4.103751/ + DATA ( BM2JI( 4, 9,IBETA ), IBETA = 1, 10 ) / + & 3.856771, 3.879363, 3.928579, 3.986207, 4.042173, + & 4.091411, 4.132041, 4.164052, 4.188343, 4.206118/ + DATA ( BM2JI( 4,10,IBETA ), IBETA = 1, 10 ) / + & 4.053923, 4.067191, 4.095509, 4.127698, 4.158037, + & 4.184055, 4.205135, 4.221592, 4.234115, 4.243463/ + DATA ( BM2JI( 5, 1,IBETA ), IBETA = 1, 10 ) / + & 0.935846, 0.906814, 0.843358, 0.768710, 0.695885, + & 0.631742, 0.579166, 0.538471, 0.508410, 0.486863/ + DATA ( BM2JI( 5, 2,IBETA ), IBETA = 1, 10 ) / + & 0.988308, 0.959524, 0.896482, 0.821986, 0.748887, + & 0.684168, 0.630908, 0.589516, 0.558676, 0.536056/ + DATA ( BM2JI( 5, 3,IBETA ), IBETA = 1, 10 ) / + & 1.133795, 1.107139, 1.048168, 0.977258, 0.906341, + & 0.842477, 0.789093, 0.746731, 0.713822, 0.687495/ + DATA ( BM2JI( 5, 4,IBETA ), IBETA = 1, 10 ) / + & 1.405692, 1.385781, 1.340706, 1.284776, 1.227085, + & 1.173532, 1.127008, 1.087509, 1.052712, 1.018960/ + DATA ( BM2JI( 5, 5,IBETA ), IBETA = 1, 10 ) / + & 1.884992, 1.879859, 1.868463, 1.854995, 1.841946, + & 1.829867, 1.816972, 1.799319, 1.771754, 1.729406/ + DATA ( BM2JI( 5, 6,IBETA ), IBETA = 1, 10 ) / + & 2.592275, 2.612268, 2.661698, 2.731803, 2.815139, + & 2.901659, 2.978389, 3.031259, 3.048045, 3.021122/ + DATA ( BM2JI( 5, 7,IBETA ), IBETA = 1, 10 ) / + & 3.390321, 3.435519, 3.545615, 3.698419, 3.876958, + & 4.062790, 4.236125, 4.378488, 4.475619, 4.519170/ + DATA ( BM2JI( 5, 8,IBETA ), IBETA = 1, 10 ) / + & 4.161376, 4.216558, 4.346896, 4.519451, 4.711107, + & 4.902416, 5.077701, 5.226048, 5.341423, 5.421764/ + DATA ( BM2JI( 5, 9,IBETA ), IBETA = 1, 10 ) / + & 4.843961, 4.892035, 5.001492, 5.138515, 5.281684, + & 5.416805, 5.535493, 5.634050, 5.712063, 5.770996/ + DATA ( BM2JI( 5,10,IBETA ), IBETA = 1, 10 ) / + & 5.352093, 5.385119, 5.458056, 5.545311, 5.632162, + & 5.710566, 5.777005, 5.830863, 5.873123, 5.905442/ + DATA ( BM2JI( 6, 1,IBETA ), IBETA = 1, 10 ) / + & 0.964038, 0.930794, 0.859433, 0.777776, 0.700566, + & 0.634671, 0.582396, 0.543656, 0.517284, 0.501694/ + DATA ( BM2JI( 6, 2,IBETA ), IBETA = 1, 10 ) / + & 1.013416, 0.979685, 0.907197, 0.824135, 0.745552, + & 0.678616, 0.625870, 0.587348, 0.561864, 0.547674/ + DATA ( BM2JI( 6, 3,IBETA ), IBETA = 1, 10 ) / + & 1.145452, 1.111457, 1.038152, 0.953750, 0.873724, + & 0.805955, 0.753621, 0.717052, 0.694920, 0.684910/ + DATA ( BM2JI( 6, 4,IBETA ), IBETA = 1, 10 ) / + & 1.376547, 1.345004, 1.276415, 1.196704, 1.121091, + & 1.058249, 1.012197, 0.983522, 0.970323, 0.968933/ + DATA ( BM2JI( 6, 5,IBETA ), IBETA = 1, 10 ) / + & 1.778801, 1.755897, 1.706074, 1.649008, 1.597602, + & 1.560087, 1.540365, 1.538205, 1.549738, 1.568333/ + DATA ( BM2JI( 6, 6,IBETA ), IBETA = 1, 10 ) / + & 2.447603, 2.445172, 2.443762, 2.451842, 2.475877, + & 2.519039, 2.580118, 2.653004, 2.727234, 2.789738/ + DATA ( BM2JI( 6, 7,IBETA ), IBETA = 1, 10 ) / + & 3.368490, 3.399821, 3.481357, 3.606716, 3.772101, + & 3.969416, 4.184167, 4.396163, 4.582502, 4.721838/ + DATA ( BM2JI( 6, 8,IBETA ), IBETA = 1, 10 ) / + & 4.426458, 4.489861, 4.648250, 4.877510, 5.160698, + & 5.477495, 5.803123, 6.111250, 6.378153, 6.586050/ + DATA ( BM2JI( 6, 9,IBETA ), IBETA = 1, 10 ) / + & 5.568061, 5.644988, 5.829837, 6.081532, 6.371214, + & 6.672902, 6.963737, 7.226172, 7.449199, 7.627886/ + DATA ( BM2JI( 6,10,IBETA ), IBETA = 1, 10 ) / + & 6.639152, 6.707020, 6.863974, 7.065285, 7.281744, + & 7.492437, 7.683587, 7.847917, 7.983296, 8.090977/ + DATA ( BM2JI( 7, 1,IBETA ), IBETA = 1, 10 ) / + & 0.980853, 0.945724, 0.871244, 0.787311, 0.708818, + & 0.641987, 0.588462, 0.547823, 0.518976, 0.500801/ + DATA ( BM2JI( 7, 2,IBETA ), IBETA = 1, 10 ) / + & 1.026738, 0.990726, 0.914306, 0.828140, 0.747637, + & 0.679351, 0.625127, 0.584662, 0.556910, 0.540749/ + DATA ( BM2JI( 7, 3,IBETA ), IBETA = 1, 10 ) / + & 1.146496, 1.108808, 1.028695, 0.938291, 0.854101, + & 0.783521, 0.728985, 0.690539, 0.667272, 0.657977/ + DATA ( BM2JI( 7, 4,IBETA ), IBETA = 1, 10 ) / + & 1.344846, 1.306434, 1.224543, 1.132031, 1.046571, + & 0.976882, 0.926488, 0.896067, 0.884808, 0.891027/ + DATA ( BM2JI( 7, 5,IBETA ), IBETA = 1, 10 ) / + & 1.670227, 1.634583, 1.558421, 1.472939, 1.396496, + & 1.339523, 1.307151, 1.300882, 1.319622, 1.360166/ + DATA ( BM2JI( 7, 6,IBETA ), IBETA = 1, 10 ) / + & 2.224548, 2.199698, 2.148284, 2.095736, 2.059319, + & 2.050496, 2.075654, 2.136382, 2.229641, 2.347958/ + DATA ( BM2JI( 7, 7,IBETA ), IBETA = 1, 10 ) / + & 3.104483, 3.105947, 3.118398, 3.155809, 3.230427, + & 3.350585, 3.519071, 3.731744, 3.976847, 4.235616/ + DATA ( BM2JI( 7, 8,IBETA ), IBETA = 1, 10 ) / + & 4.288426, 4.331456, 4.447024, 4.633023, 4.891991, + & 5.221458, 5.610060, 6.036467, 6.471113, 6.880462/ + DATA ( BM2JI( 7, 9,IBETA ), IBETA = 1, 10 ) / + & 5.753934, 5.837061, 6.048530, 6.363800, 6.768061, + & 7.241280, 7.755346, 8.276666, 8.771411, 9.210826/ + DATA ( BM2JI( 7,10,IBETA ), IBETA = 1, 10 ) / + & 7.466219, 7.568810, 7.819032, 8.168340, 8.582973, + & 9.030174, 9.478159, 9.899834, 10.275940, 10.595910/ + DATA ( BM2JI( 8, 1,IBETA ), IBETA = 1, 10 ) / + & 0.990036, 0.954782, 0.880531, 0.797334, 0.719410, + & 0.652220, 0.596923, 0.552910, 0.519101, 0.494529/ + DATA ( BM2JI( 8, 2,IBETA ), IBETA = 1, 10 ) / + & 1.032428, 0.996125, 0.919613, 0.833853, 0.753611, + & 0.684644, 0.628260, 0.583924, 0.550611, 0.527407/ + DATA ( BM2JI( 8, 3,IBETA ), IBETA = 1, 10 ) / + & 1.141145, 1.102521, 1.021017, 0.929667, 0.844515, + & 0.772075, 0.714086, 0.670280, 0.639824, 0.621970/ + DATA ( BM2JI( 8, 4,IBETA ), IBETA = 1, 10 ) / + & 1.314164, 1.273087, 1.186318, 1.089208, 0.999476, + & 0.924856, 0.867948, 0.829085, 0.807854, 0.803759/ + DATA ( BM2JI( 8, 5,IBETA ), IBETA = 1, 10 ) / + & 1.580611, 1.538518, 1.449529, 1.350459, 1.260910, + & 1.190526, 1.143502, 1.121328, 1.124274, 1.151974/ + DATA ( BM2JI( 8, 6,IBETA ), IBETA = 1, 10 ) / + & 2.016773, 1.977721, 1.895727, 1.806974, 1.732891, + & 1.685937, 1.673026, 1.697656, 1.761039, 1.862391/ + DATA ( BM2JI( 8, 7,IBETA ), IBETA = 1, 10 ) / + & 2.750093, 2.723940, 2.672854, 2.628264, 2.612250, + & 2.640406, 2.723211, 2.866599, 3.071893, 3.335217/ + DATA ( BM2JI( 8, 8,IBETA ), IBETA = 1, 10 ) / + & 3.881905, 3.887143, 3.913667, 3.981912, 4.111099, + & 4.316575, 4.608146, 4.988157, 5.449592, 5.974848/ + DATA ( BM2JI( 8, 9,IBETA ), IBETA = 1, 10 ) / + & 5.438870, 5.492742, 5.640910, 5.886999, 6.241641, + & 6.710609, 7.289480, 7.960725, 8.693495, 9.446644/ + DATA ( BM2JI( 8,10,IBETA ), IBETA = 1, 10 ) / + & 7.521152, 7.624621, 7.892039, 8.300444, 8.839787, + & 9.493227, 10.231770, 11.015642, 11.799990, 12.542260/ + DATA ( BM2JI( 9, 1,IBETA ), IBETA = 1, 10 ) / + & 0.994285, 0.960012, 0.887939, 0.807040, 0.730578, + & 0.663410, 0.606466, 0.559137, 0.520426, 0.489429/ + DATA ( BM2JI( 9, 2,IBETA ), IBETA = 1, 10 ) / + & 1.033505, 0.998153, 0.923772, 0.840261, 0.761383, + & 0.692242, 0.633873, 0.585709, 0.546777, 0.516215/ + DATA ( BM2JI( 9, 3,IBETA ), IBETA = 1, 10 ) / + & 1.132774, 1.094907, 1.015161, 0.925627, 0.841293, + & 0.767888, 0.706741, 0.657439, 0.619135, 0.591119/ + DATA ( BM2JI( 9, 4,IBETA ), IBETA = 1, 10 ) / + & 1.286308, 1.245273, 1.158809, 1.061889, 0.971208, + & 0.893476, 0.830599, 0.782561, 0.748870, 0.729198/ + DATA ( BM2JI( 9, 5,IBETA ), IBETA = 1, 10 ) / + & 1.511105, 1.467141, 1.374520, 1.271162, 1.175871, + & 1.096887, 1.037243, 0.997820, 0.978924, 0.980962/ + DATA ( BM2JI( 9, 6,IBETA ), IBETA = 1, 10 ) / + & 1.857468, 1.812177, 1.717002, 1.612197, 1.519171, + & 1.448660, 1.405871, 1.393541, 1.413549, 1.467532/ + DATA ( BM2JI( 9, 7,IBETA ), IBETA = 1, 10 ) / + & 2.430619, 2.388452, 2.301326, 2.210241, 2.139724, + & 2.104571, 2.114085, 2.174696, 2.291294, 2.467500/ + DATA ( BM2JI( 9, 8,IBETA ), IBETA = 1, 10 ) / + & 3.385332, 3.357690, 3.306611, 3.269804, 3.274462, + & 3.340862, 3.484609, 3.717740, 4.048748, 4.481588/ + DATA ( BM2JI( 9, 9,IBETA ), IBETA = 1, 10 ) / + & 4.850497, 4.858280, 4.896008, 4.991467, 5.171511, + & 5.459421, 5.873700, 6.426128, 7.119061, 7.942603/ + DATA ( BM2JI( 9,10,IBETA ), IBETA = 1, 10 ) / + & 6.957098, 7.020164, 7.197272, 7.499331, 7.946554, + & 8.555048, 9.330503, 10.263610, 11.327454, 12.478332/ + DATA ( BM2JI( 10, 1,IBETA ), IBETA = 1, 10 ) / + & 0.994567, 0.961842, 0.892854, 0.814874, 0.740198, + & 0.673303, 0.615105, 0.565139, 0.522558, 0.486556/ + DATA ( BM2JI( 10, 2,IBETA ), IBETA = 1, 10 ) / + & 1.031058, 0.997292, 0.926082, 0.845571, 0.768501, + & 0.699549, 0.639710, 0.588538, 0.545197, 0.508894/ + DATA ( BM2JI( 10, 3,IBETA ), IBETA = 1, 10 ) / + & 1.122535, 1.086287, 1.009790, 0.923292, 0.840626, + & 0.766982, 0.703562, 0.650004, 0.605525, 0.569411/ + DATA ( BM2JI( 10, 4,IBETA ), IBETA = 1, 10 ) / + & 1.261142, 1.221555, 1.137979, 1.043576, 0.953745, + & 0.874456, 0.807292, 0.752109, 0.708326, 0.675477/ + DATA ( BM2JI( 10, 5,IBETA ), IBETA = 1, 10 ) / + & 1.456711, 1.413432, 1.322096, 1.219264, 1.122319, + & 1.038381, 0.969743, 0.916811, 0.879544, 0.858099/ + DATA ( BM2JI( 10, 6,IBETA ), IBETA = 1, 10 ) / + & 1.741792, 1.695157, 1.596897, 1.487124, 1.385734, + & 1.301670, 1.238638, 1.198284, 1.181809, 1.190689/ + DATA ( BM2JI( 10, 7,IBETA ), IBETA = 1, 10 ) / + & 2.190197, 2.141721, 2.040226, 1.929245, 1.832051, + & 1.760702, 1.721723, 1.719436, 1.757705, 1.840677/ + DATA ( BM2JI( 10, 8,IBETA ), IBETA = 1, 10 ) / + & 2.940764, 2.895085, 2.801873, 2.707112, 2.638603, + & 2.613764, 2.644686, 2.741255, 2.912790, 3.168519/ + DATA ( BM2JI( 10, 9,IBETA ), IBETA = 1, 10 ) / + & 4.186191, 4.155844, 4.101953, 4.069102, 4.089886, + & 4.189530, 4.389145, 4.707528, 5.161567, 5.765283/ + DATA ( BM2JI( 10,10,IBETA ), IBETA = 1, 10 ) / + & 6.119526, 6.127611, 6.171174, 6.286528, 6.508738, + & 6.869521, 7.396912, 8.113749, 9.034683, 10.162190/ + +C *** end of data statements. + +C---------------------------------------------------------------------- + + CONSTII = ABS( HALF * ( TWO ) ** TWO3RDS - ONE ) + SQRTTWO = SQRT( TWO ) + DLGSQT2 = ONE / LOG( SQRTTWO ) + + ESAT01 = EXP( 0.125D0 * XXLSGAT * XXLSGAT ) + ESAC01 = EXP( 0.125D0 * XXLSGAC * XXLSGAC ) + + ESAT04 = ESAT01 ** 4 + ESAC04 = ESAC01 ** 4 + + ESAT05 = ESAT04 * ESAT01 + ESAC05 = ESAC04 * ESAC01 + + ESAT08 = ESAT04 * ESAT04 + ESAC08 = ESAC04 * ESAC04 + + ESAT09 = ESAT08 * ESAT01 + ESAC09 = ESAC08 * ESAC01 + + ESAT16 = ESAT08 * ESAT08 + ESAC16 = ESAC08 * ESAC08 + + ESAT20 = ESAT16 * ESAT04 + ESAC20 = ESAC16 * ESAC04 + + ESAT24 = ESAT20 * ESAT04 + ESAC24 = ESAC20 * ESAC04 + + ESAT25 = ESAT20 * ESAT05 + ESAC25 = ESAC20 * ESAC05 + + ESAT36 = ESAT20 * ESAT16 + ESAC36 = ESAC20 * ESAC16 + + ESAT49 = ESAT24 * ESAT25 + + ESAT64 = ESAT20 * ESAT20 * ESAT24 + ESAC64 = ESAC20 * ESAC20 * ESAC24 + + ESAT100 = ESAT64 * ESAT36 + + DGAT2 = DGATK * DGATK + DGAT3 = DGATK * DGATK * DGATK + DGAC2 = DGACC * DGACC + DGAC3 = DGACC * DGACC * DGACC + + SQDGAT = SQRT( DGATK ) + SQDGAC = SQRT( DGACC ) + SQDGAT5 = DGAT2 * SQDGAT + SQDGAC5 = DGAC2 * SQDGAC + SQDGAT7 = DGAT3 * SQDGAT + + XM2AT = DGAT2 * ESAT16 + XM3AT = DGAT3 * ESAT36 + + XM2AC = DGAC2 * ESAC16 + XM3AC = DGAC3 * ESAC36 + +C *** For the free molecular regime: Page H.3 of Whitby et al. (1991) + R = SQDGAC / SQDGAT + R2 = R * R + R3 = R2 * R + R4 = R2 * R2 + R5 = R3 * R2 + R6 = R3 * R3 + R8 = R4 * R4 + RI1 = ONE / R + RI2 = ONE / R2 + RI3 = ONE / R3 + RI4 = RI2 * RI2 + KNGAT = TWO * LAMDA / DGATK + KNGAC = TWO * LAMDA / DGACC + +C *** Calculate ratio of geometric mean diameters + RAT = DGACC / DGATK + +C *** Trap subscripts for BM0 and BM0I, between 1 and 10 +c See page H.5 of Whitby et al. (1991) + N2N = MAX( 1, MIN( 10, + & NINT( 4.0 * ( SGATK - 0.75D0 ) ) ) ) + N2A = MAX( 1, MIN( 10, + & NINT( 4.0 * ( SGACC - 0.75D0 ) ) ) ) + N1 = MAX( 1, MIN( 10, + & 1 + NINT( DLGSQT2 * LOG( RAT ) ) ) ) + +C *** Intermodal Coagulation + +C *** Set up for zeroth moment + +C *** Near-continuum form: Equation H.10a of Whitby et al. (1991) + COAGNC0 = KNC * ( + & TWO + A * ( KNGAT * ( ESAT04 + R2 * ESAT16 * ESAC04 ) + & + KNGAC * ( ESAC04 + RI2 * ESAC16 * ESAT04 ) ) + & + ( R2 + RI2 ) * ESAT04 * ESAC04 ) + + +C *** Free-molecular form: Equation H.7a of Whitby et al. (1991) + COAGFM0 = KFMATAC * SQDGAT * BM0IJ( N1,N2N,N2A ) * ( + & ESAT01 + R * ESAC01 + TWO * R2 * ESAT01 * ESAC04 + & + R4 * ESAT09 * ESAC16 + RI3 * ESAT16 * ESAC09 + & + TWO * RI1 * ESAT04 + ESAC01 ) + +C *** Loss to accumulation mode + +C *** Harmonic Mean + COAGATAC0 = COAGNC0 * COAGFM0 / ( COAGNC0 + COAGFM0 ) + + QN12 = COAGATAC0 + +C *** Set up for second moment +C The second moment equations are new and begin with equations A1 +C through A4 of Binkowski and Shankar (1995). After some algebraic +C rearrangement and application of the extended mean value theorem +C of integral calculus, equations are obtained that can be solved +C analytically with correction factors as has been done by +C Whitby et al. (1991) + +C *** The term ( dp1 + dp2 ) ** (2/3) in Equations A3 and A4 of +C Binkowski and Shankar (1995) is approximated by +C (DGAT ** 3 + DGAC **3 ) ** 2/3 + +C *** Near-continuum form + I1NC = KNC * DGAT2 * ( + & TWO * ESAT16 + & + R2 * ESAT04 * ESAC04 + & + RI2 * ESAT36 * ESAC04 + & + A * KNGAT * ( + & ESAT04 + & + RI2 * ESAT16 * ESAC04 + & + RI4 * ESAT36 * ESAC16 + & + R2 * ESAC04 ) ) + +C *** Free-molecular form + I1FM = KFMATAC * SQDGAT5 * BM2IJ( N1,N2N,N2A ) * ( + & ESAT25 + & + TWO * R2 * ESAT09 * ESAC04 + & + R4 * ESAT01 * ESAC16 + & + RI3 * ESAT64 * ESAC09 + & + TWO * RI1 * ESAT36 * ESAC01 + & + R * ESAT16 * ESAC01 ) + +C *** Loss to accumulation mode + +C *** Harmonic mean + I1 = ( I1FM * I1NC ) / ( I1FM + I1NC ) + COAGATAC2 = I1 + QS12 = COAGATAC2 + +C *** Gain by accumulation mode + COAGACAT2 = ( ( ONE + R6 ) ** TWO3RDS - R4 ) * I1 + QS21 = COAGACAT2 * BM2JI( N1,N2N,N2A ) + +C *** Set up for third moment + +C *** Near-continuum form: Equation H.10b of Whitby et al. (1991) + COAGNC3 = KNC * DGAT3 * ( + & TWO * ESAT36 + & + A * KNGAT * ( ESAT16 + R2 * ESAT04 * ESAC04 ) + & + A * KNGAC * ( ESAT36 * ESAC04 + RI2 * ESAT64 * ESAC16 ) + & + R2 * ESAT16 * ESAC04 + RI2 * ESAT64 * ESAC04 ) + +C *** Free_molecular form: Equation H.7b of Whitby et al. (1991) + COAGFM3 = KFMATAC * SQDGAT7 * BM3I( N1, N2N, N2A ) * ( + & ESAT49 + & + R * ESAT36 * ESAC01 + & + TWO * R2 * ESAT25 * ESAC04 + & + R4 * ESAT09 * ESAC16 + & + RI3 * ESAT100 * ESAC09 + & + TWO * RI1 * ESAT64 * ESAC01 ) + +C *** gain by accumulation mode = loss from Aitken mode + +C *** Harmonic mean + COAGATAC3 = COAGNC3 * COAGFM3 / ( COAGNC3 + COAGFM3 ) + QV12 = COAGATAC3 + +C *** Intramodal coagulation + +C *** Zeroeth moment + +C *** Aitken mode + +C *** Near-continuum form: Equation H.12a of Whitby et al. (1991) + COAGNC_AT = KNC * (ONE + ESAT08 + A * KNGAT * ( ESAT20 + ESAT04 ) ) + +C *** Free-molecular form: Equation H.11a of Whitby et al. (1991) + COAGFM_AT = KFMAT * SQDGAT * BM0( N2N ) * + & ( ESAT01 + ESAT25 + TWO * ESAT05 ) + +C *** Harmonic mean + COAGATAT0 = COAGFM_AT * COAGNC_AT / ( COAGFM_AT + COAGNC_AT ) + QN11 = COAGATAT0 + +C *** Accumulation mode + +C *** Near-continuum form: Equation H.12a of Whitby et al. (1991) + COAGNC_AC = KNC * (ONE + ESAC08 + A * KNGAC * ( ESAC20 + ESAC04 ) ) + +C *** Free-molecular form: Equation H.11a of Whitby et al. (1991) + COAGFM_AC = KFMAC * SQDGAC * BM0( N2A ) * + & ( ESAC01 + ESAC25 + TWO * ESAC05 ) + +C *** Harmonic mean + COAGACAC0 = COAGFM_AC * COAGNC_AC / ( COAGFM_AC + COAGNC_AC ) + QN22 = COAGACAC0 + +C *** Set up for second moment +C The second moment equations are new and begin with 3.11a on Page +c 45 of Whitby et al. (1991). After some algebraic rearrangement and +c application of the extended mean value theorem of integral calculus +c equations are obtained that can be solved analytically with +c correction factors as has been done by Whitby et al. (1991) + +C *** Aitken mode + +C *** Near-continuum + I1NC_AT = KNC * DGAT2 * ( + & TWO * ESAT16 + & + ESAT04 * ESAT04 + & + ESAT36 * ESAT04 + & + A * KNGAT * ( + & TWO * ESAT04 + & + ESAT16 * ESAT04 + & + ESAT36 * ESAT16 ) ) + +C *** Free- molecular form + I1FM_AT = KFMAT * SQDGAT5 * BM2II( N2N ) * ( + & ESAT25 + & + TWO * ESAT09 * ESAT04 + & + ESAT01 * ESAT16 + & + ESAT64 * ESAT09 + & + TWO * ESAT36 * ESAT01 + & + ESAT16 * ESAT01 ) + + I1_AT = ( I1NC_AT * I1FM_AT ) / ( I1NC_AT + I1FM_AT ) + COAGATAT2 = CONSTII * I1_AT + QS11 = COAGATAT2 * BM2IITT( N2N ) + +C *** Accumulation mode + +C *** Near-continuum + I1NC_AC = KNC * DGAC2 * ( + & TWO * ESAC16 + & + ESAC04 * ESAC04 + & + ESAC36 * ESAC04 + & + A * KNGAC * ( + & TWO * ESAC04 + & + ESAC16 * ESAC04 + & + ESAC36 * ESAC16 ) ) + +C *** Free-molecular form + I1FM_AC = KFMAC * SQDGAC5 * BM2II( N2A ) * ( + & ESAC25 + & + TWO * ESAC09 * ESAC04 + & + ESAC01 * ESAC16 + & + ESAC64 * ESAC09 + & + TWO * ESAC36 * ESAC01 + & + ESAC16 * ESAC01 ) + + I1_AC = ( I1NC_AC * I1FM_AC ) / ( I1NC_AC + I1FM_AC ) + COAGACAC2 = CONSTII * I1_AC + QS22 = COAGACAC2 * BM2IITT( N2A ) + + RETURN + + END SUBROUTINE GETCOAGS + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + subroutine intracoag_gh( lamda, kfm, knc, dg, xlnsig, + & quads11, quadn11 ) + +c Gauss-Hermite numerical quadrature to calculate intramodal coagulation +c rates for number and second moment + +c FSB: This version runs in real*8 arithmetic + +c *** This version calculates the coagulation coefficients using the harmonic +c mean approach for both fm and nc cases. +c *** Does gauss-hermite quadrature for intra-modal coagulation integrals for +c 2nd moment for a lognormal distribution defined by dg, xlnsig, +c *** dg and xlnsig are the geometric mean diameters (meters) and the logarithms +c of the geometric standard deviations (dimensionless) whose meaning is +c defined below at the end of the routine ghxi, ghwi are the gauss-hermite +c weights and n is one-half the number of abscissas, since an even number +c of abscissas is used + + implicit none + +c *** arguments: + real( 8 ), intent( in ) :: lamda ! mean free path + real( 8 ), intent( in ) :: kfm, knc + real, intent( in ) :: dg, xlnsig + real( 8 ), intent( out ) :: quads11, quadn11 + +c *** parameters: + real( 8 ), parameter :: pi = 3.14159265358979324d0 + real( 8 ), parameter :: two3rds = 2.0d0 / 3.0d0 + real( 8 ), parameter :: sqrt2 = 1.414213562373095d0 + real( 8 ), parameter :: A = 1.246d0 ! approx Cunningham corr. factor + real( 8 ), parameter :: twoA = 2.0d0 * A + +c *** local variables: + real( 8 ) :: sum1sfm, sum2sfm, sum1nfm, sum2nfm + real( 8 ) :: sum1snc, sum2snc, sum1nnc, sum2nnc + real( 8 ) :: xi, wxi, xf, dp1p, dp1m, dp1psq, dp1msq + real( 8 ) :: v1p,v1m, a2p, a2m, v2p, v2m + real( 8 ) :: yi, wyi, yf, dp2p, dp2m, dp2psq, dp2msq + real( 8 ) :: dspp, dsmp, dspm, dsmm + real( 8 ) :: bppfm, bmpfm, bpmfm, bmmfm + real( 8 ) :: bppnc, bmpnc, bpmnc, bmmnc + real( 8 ) :: xx1, xx2 + real( 8 ) :: xbsfm, xbsnc, xbnfm, xbnnc + integer i, j + +c *** Has a fixed number of Gauss-Herimite abscissas (n) + integer, parameter :: n = 5 ! one-half the number of abscissas + real( 8 ) :: ghxi( n ) ! Gauss-Hermite abscissas + real( 8 ) :: ghwi( n ) ! Gauss-Hermite weights + +c *** Values from Table 25.10 (page 924) of Abramowitz and Stegun, +c Handbook of Mathematical Functions, National Bureau of Standards, +c December 1965. +c (Breaks in number to facilitate comparison with printed table.) + +c *** tests show that 10 point is adquate. + + data ghxi/ 0.34290 13272 23705d0, + & 1.03661 08297 89514d0, + & 1.75668 36492 99882d0, + & 2.53273 16742 32790d0, + & 3.43615 91188 37738d0 /, + + & ghwi/ 6.10862 63373 53d-01, + & 2.40138 61108 23d-01, + & 3.38743 94455 48d-02, + & 1.34364 57467 81d-03, + & 7.64043 28552 33d-06 / + +c *** The following Statement Functions are based on expressions from +c Binkowski & Shanker, Jour. Geophys. Research. Vol. 100, no. d12, +c pp 26,191-26,209 December 20, 1995 + + real( 8 ) :: betafm, betanc + +c *** for Free Molecular, Eq. A5 + betafm( xx1, xx2 ) = kfm + & * sqrt( 1.d0 / xx1 ** 3 + 1.d0 / xx2 ** 3 ) + & * ( xx1 + xx2 ) ** 2 + +c *** for Near Continuum, Eq. A6 + betanc( xx1, xx2 ) = knc * ( xx1 + xx2 ) + & * ( 1.0D0 / xx1 + 1.0d0 / xx2 + twoA * lamda + & * ( 1.0d0 / xx1 ** 2 + 1.0d0 / xx2 ** 2 ) ) +C----------------------------------------------------------------------- + + sum1sfm = 0.d0 + sum1snc = 0.d0 + sum1nfm = 0.d0 + sum1nnc = 0.d0 + do 201 i = 1, n + + sum2sfm = 0.d0 + sum2snc = 0.d0 + sum2nfm = 0.d0 + sum2nnc = 0.d0 + + xi = ghxi( i ) + wxi = ghwi( i ) + xf = exp( sqrt2 * xi * xlnsig ) + dp1p = dg * xf + dp1m = dg / xf + dp1psq = dp1p * dp1p + dp1msq = dp1m * dp1m + v1p = dp1p * dp1psq + v1m = dp1m * dp1msq + do 101 j = 1, n + yi = ghxi( j ) + wyi = ghwi( j ) + yf = exp( sqrt2 * yi * xlnsig ) + dp2p = dg * yf + dp2m = dg / yf + dp2psq = dp2p * dp2p + dp2msq = dp2m * dp2m + a2p = dp2psq + a2m = dp2msq + v2p = dp2p * dp2psq + v2m = dp2m * dp2msq + dspp = 0.5d0 * ( v1p + v2p ) ** two3rds - a2p + dsmp = 0.5d0 * ( v1m + v2p ) ** two3rds - a2p + dspm = 0.5d0 * ( v1p + v2m ) ** two3rds - a2m + dsmm = 0.5d0 * ( v1m + v2m ) ** two3rds - a2m + + bppfm = betafm( dp1p, dp2p ) + bmpfm = betafm( dp1m, dp2p ) + bpmfm = betafm( dp1p, dp2m ) + bmmfm = betafm( dp1m, dp2m ) + + bppnc = betanc( dp1p, dp2p ) + bmpnc = betanc( dp1m, dp2p ) + bpmnc = betanc( dp1p, dp2m ) + bmmnc = betanc( dp1m, dp2m ) + + sum2sfm = sum2sfm + wyi * ( dspp * bppfm + dspm * bpmfm + & + dsmp * bmpfm + dsmm * bmmfm ) + + sum2nfm = sum2nfm + wyi * ( bppfm + bmpfm + bpmfm + bmmfm ) + sum2snc = sum2snc + wyi * ( dspp * bppnc + dspm * bpmnc + & + dsmp * bmpnc + dsmm * bmmnc ) + sum2nnc = sum2nnc + wyi * ( bppnc + bmpnc + bpmnc + bmmnc ) + +101 continue + sum1sfm = sum1sfm + wxi * sum2sfm + sum1nfm = sum1nfm + wxi * sum2nfm + + sum1snc = sum1snc + wxi * sum2snc + sum1nnc = sum1nnc + wxi * sum2nnc + +201 continue + +c *** quads11 is the intra-modal coagulation term for 2nd moment + xbsfm = -sum1sfm / pi + xbsnc = -sum1snc / pi + quads11 = xbsfm * xbsnc / ( xbsfm + xbsnc ) + +c *** quadn11 is the intra-modal coagulation term for number + xbnfm = 0.5D0 * sum1nfm / pi + xbnnc = 0.5D0 * sum1nnc / pi + quadn11 = xbnfm * xbnnc / ( xbnfm + xbnnc ) + + return + end subroutine intracoag_gh + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + subroutine intercoag_gh( lamda, kfm, knc, dg1, dg2, xlnsig1, xlnsig2, + & quads12, quads21, quadn12, quadv12 ) + +c Gauss-Hermite numerical quadrature to calculate intermodal coagulation +c for number, 2nd, and 3rd moment + +c FSB This version runs in real*8 arithmetic + +c *** This version calculates the coagulation coefficients using the harmonic +c mean approach for both fm and nc cases. +c *** Does gauss-hermite quadrature for inter-modal coagulation integrals +c for 2nd moment for two lognormal distributions defined by dg1, xlnsig1, +c dg2, xlnsig2. +c *** dg and xlnsig are the geometric mean diameters (meters) and the logarithms +c of the geometric standard deviations (dimensionless), whose meaning is +c defined below at the end of the routine. +c ghxi, ghwi are the gauss-hermite weights and n is one-half the +c number of abscissas, since an even number of abscissas is used. + + implicit none + + +c *** arguments: + real( 8 ), intent( in ) :: lamda ! mean free path + real( 8 ), intent( in ) :: kfm, knc + real, intent( in ) :: dg1, dg2, xlnsig1, xlnsig2 + real( 8 ), intent( out ) :: quads12, quads21, quadn12, quadv12 + +c *** parameters: + real( 8 ), parameter :: pi = 3.14159265358979324d0 + real( 8 ), parameter :: two3rds = 2.0d0 / 3.0d0 + real( 8 ), parameter :: sqrt2 = 1.414213562373095d0 + real( 8 ), parameter :: A = 1.246d0 ! approx Cunningham corr. factor + real( 8 ), parameter :: twoA = 2.0d0 * A + +c *** local variables: + real( 8 ) :: sum1s12fm, sum1s21fm, sum2s12fm, sum2s21fm + real( 8 ) :: sum1nfm, sum2nfm + real( 8 ) :: sum1vfm, sum2vfm + real( 8 ) :: sum1s12nc, sum1s21nc, sum2s12nc, sum2s21nc + real( 8 ) :: sum1nnc, sum2nnc + real( 8 ) :: sum1vnc, sum2vnc + real( 8 ) :: xi, wxi,xf, dp1p, dp1m, dp1psq, dp1msq + real( 8 ) :: a1p, a1m, v1p, v1m + real( 8 ) :: a2p, a2m, v2p, v2m + real( 8 ) :: yi, wyi, yf, dp2p, dp2m, dp2psq, dp2msq + real( 8 ) :: dspp, dsmp, dspm, dsmm + real( 8 ) :: bppfm, bmpfm, bpmfm, bmmfm + real( 8 ) :: bppnc, bmpnc, bpmnc, bmmnc + real( 8 ) :: xx1, xx2 + real( 8 ) :: xbsfm, xbsnc, xbnfm, xbnnc, xbvfm, xbvnc + integer i, j + +c *** Has a fixed number of Gauss-Herimite abscissas (n) + integer, parameter :: n = 5 ! one-half the number of abscissas + real( 8 ) :: ghxi( n ) ! Gauss-Hermite abscissas + real( 8 ) :: ghwi( n ) ! Gauss-Hermite weights + +c *** Values from Table 25.10 (page 924) of Abramowitz and Stegun, +c Handbook of Mathematical Functions, National Bureau of Standards, +c December 1965. +c (Breaks in number to facilitate comparison with printed table.) + +c *** tests show that 10 point is adquate. + + data ghxi/ 0.34290 13272 23705D0, + & 1.03661 08297 89514D0, + & 1.75668 36492 99882D0, + & 2.53273 16742 32790D0, + & 3.43615 91188 37738D0 /, + + & ghwi/ 6.10862 63373 53d-01, + & 2.40138 61108 23d-01, + & 3.38743 94455 48d-02, + & 1.34364 57467 81d-03, + & 7.64043 28552 33d-06 / + +c *** The following Statement Functions are based on expressions from +c Binkowski & Shanker, Jour. Geophys. Research. Vol. 100, no. d12, +c pp 26,191-26,209 December 20, 1995 + + real( 8 ) :: betafm, betanc + +c *** for Free Molecular, Eq. A5 + betafm( xx1, xx2 ) = kfm + & * sqrt( 1.d0 / xx1 ** 3 + 1.d0 / xx2 ** 3 ) + & * ( xx1 + xx2 ) ** 2 + +c *** for Near Continuum, Eq. A6 + betanc( xx1, xx2 ) = knc * ( xx1 + xx2 ) + & * ( 1.0D0 / xx1 + 1.0d0 / xx2 + twoA * lamda + & * ( 1.0d0 / xx1 ** 2 + 1.0d0 / xx2 ** 2 ) ) +c----------------------------------------------------------------------- + + sum1s12fm = 0.d0 + sum1s12nc = 0.d0 + sum1s21fm = 0.d0 + sum1s21nc = 0.d0 + sum1vnc = 0.d0 + sum1vfm = 0.d0 + sum1nfm = 0.d0 + sum1nnc = 0.d0 + do 201 i = 1, n + + sum2s12fm = 0.d0 + sum2s12nc = 0.d0 + sum2s21fm = 0.d0 + sum2s21nc = 0.d0 + sum2nfm = 0.d0 + sum2nnc = 0.d0 + sum2vnc = 0.d0 + sum2vfm = 0.d0 + xi = ghxi( i ) + wxi = ghwi( i ) + xf = exp( sqrt2 * xi *xlnsig1 ) + dp1p = dg1 * xf + dp1m = dg1 / xf + dp1psq = dp1p * dp1p + dp1msq = dp1m * dp1m + a1p = dp1psq + a1m = dp1msq + v1p = dp1p * dp1psq + v1m = dp1m * dp1msq + + do 101 j = 1, n + yi = ghxi( j ) + wyi = ghwi( j ) + yf = exp( sqrt2 * yi * xlnsig2 ) + dp2p = dg2 * yf + dp2m = dg2 / yf + dp2psq = dp2p * dp2p + dp2msq = dp2m * dp2m + a2p = dp2psq + a2m = dp2msq + v2p = dp2p * dp2psq + v2m = dp2m * dp2msq + dspp = ( v1p + v2p ) ** two3rds - a2p + dsmp = ( v1m + v2p ) ** two3rds - a2p + dspm = ( v1p + v2m ) ** two3rds - a2m + dsmm = ( v1m + v2m ) ** two3rds - a2m + + bppfm = betafm( dp1p, dp2p ) + bmpfm = betafm( dp1m, dp2p ) + bpmfm = betafm( dp1p, dp2m ) + bmmfm = betafm( dp1m, dp2m ) + + bppnc = betanc( dp1p, dp2p ) + bmpnc = betanc( dp1m, dp2p ) + bpmnc = betanc( dp1p, dp2m ) + bmmnc = betanc( dp1m, dp2m ) + + sum2s12fm = sum2s12fm + wyi * ( a1p * bppfm + a1p * bpmfm + & + a1m * bmpfm + a1m * bmmfm ) + + sum2s21fm = sum2s21fm + wyi * ( dspp * bppfm + dspm * bpmfm + & + dsmp * bmpfm + dsmm * bmmfm ) + + sum2s12nc = sum2s12nc + wyi * ( a1p * bppnc + a1p * bpmnc + & + a1m * bmpnc + a1m * bmmnc ) + + sum2s21nc = sum2s21nc + wyi * ( dspp * bppnc + dspm * bpmnc + & + dsmp * bmpnc + dsmm * bmmnc ) + + sum2nfm = sum2nfm + wyi * ( bppfm + bmpfm + bpmfm + bmmfm ) + + sum2nnc = sum2nnc + wyi * ( bppnc + bmpnc + bpmnc + bmmnc ) + + sum2vfm = sum2vfm + wyi * ( v1p * ( bppfm + bpmfm ) + & + v1m * ( bmpfm + bmmfm ) ) + + sum2vnc = sum2vnc + wyi * ( v1p * ( bppnc + bpmnc) + & + v1m * ( bmpnc + bmmnc) ) + +101 continue + + sum1s12fm = sum1s12fm + wxi * sum2s12fm + sum1s21fm = sum1s21fm + wxi * sum2s21fm + sum1nfm = sum1nfm + wxi * sum2nfm + sum1vfm = sum1vfm + wxi * sum2vfm + + sum1s12nc = sum1s12nc + wxi * sum2s12nc + sum1s21nc = sum1s21nc + wxi * sum2s21nc + sum1nnc = sum1nnc + wxi * sum2nnc + sum1vnc = sum1vnc + wxi * sum2vnc + +201 continue + +C *** Second moment intermodal coagulation coefficients + +c FSB NOTE: the transfer of second moment is not symmetric. +c See equations A3 & A4 of Binkowski & Shankar (1995) + +c *** to accumulation mode from Aitken mode + xbsfm = sum1s21fm / pi + xbsnc = sum1s21nc / pi + quads21 = xbsfm * xbsnc / ( xbsfm + xbsnc ) + +c *** from Aitken mode to accumulation mode + xbsfm = sum1s12fm / pi + xbsnc = sum1s12nc / pi + quads12 = xbsfm * xbsnc / ( xbsfm + xbsnc ) + +c *** quadn12 is the intermodal coagulation coefficient for number + xbnfm = sum1nfm / pi + xbnnc = sum1nnc / pi + quadn12 = xbnfm * xbnnc / ( xbnfm + xbnnc ) + +c *** quadv12 is the intermodal coagulation coefficient for 3rd moment + xbvfm = sum1vfm / pi + xbvnc = sum1vnc / pi + quadv12 = xbvfm * xbvnc / ( xbvfm + xbvnc ) + + return + end subroutine intercoag_gh + diff --git a/models/CCTM/aero/blank/getpar.f b/models/CCTM/aero/blank/getpar.f new file mode 100755 index 0000000..990bd2e --- /dev/null +++ b/models/CCTM/aero/blank/getpar.f @@ -0,0 +1,174 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/getpar.f,v 1.7 2012/01/19 13:13:27 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Subroutine getpar( m3_wet_flag, limit_sg ) + +C Calculates the 3rd moments (M3), masses, aerosol densities, and +C geometric mean diameters (Dg) of all 3 modes, and the natural logs of +C geometric standard deviations (Sg) of the Aitken and accumulation modes. + +C The input logical variable, M3_WET_FLAG, dictates whether the +C calculations in GETPAR are to assume that the aerosol is "wet" or +C "dry." In the present context, a "wet" aerosol consists of all +C chemical components of the aerosol. A "dry" aerosol excludes +C particle-bound water and also excludes secondary organic aerosol. + +C NOTE! 2nd moment concentrations (M2) are passed into GETPAR in the +C CBLK array and are modified within GETPAR only in the event that +C the Sg value of a given mode has gone outside of the acceptable +C range (1.05 to 2.50). The GETPAR calculations implicitly assume +C that the input value of M2 is consistent with the input value of +C M3_WET_FLAG. If, for example, the input M2 value was calculated +C for a "dry" aerosol and the M3_WET_FLAG is .TRUE., GETPAR would +C incorrectly adjust the M2 concentrations! + +C +C SH 03/10/11 Renamed met_data to aeromet_data +C----------------------------------------------------------------------- + + Use aero_data + Use aeromet_data ! Includes CONST.EXT + + Implicit None + +C Arguments: + Logical, Intent( In ) :: m3_wet_flag ! true = include H2O and SOA in 3rd moment + ! false = exclude H2O and SOA from 3rd moment + + Logical, Intent( In ) :: limit_sg ! fix coarse and accum Sg's to the input value? + +C Output variables: +C updates arrays in aero_data module +C moment3_conc 3rd moment concentration [ ug /m**3 ] +C aeromode_mass mass concentration: [ ug / m**3 ] +C aeromode_dens avg particle density [ kg / m**3 ] +C aeromode_diam geometric mean diameter [ m ] +C aeromode_sdev log of geometric standard deviation + +C Local Variables: + Real( 8 ) :: xxm0 ! temporary storage of moment 0 conc's + Real( 8 ) :: xxm2 ! temporary storage of moment 2 conc's + Real( 8 ) :: xxm3 ! temporary storage of moment 3 conc's + Real( 8 ) :: xfsum ! (ln(M0)+2ln(M3))/3; used in Sg calcs + Real( 8 ) :: lxfm2 ! ln(M2); used in Sg calcs + Real( 8 ) :: l2sg ! square of ln(Sg); used in diameter calcs + Real :: es36 ! exp(4.5*l2sg); used in diameter calcs + Real :: m3augm ! temp variable for wet 3rd moment calcs + + Real( 8 ), Parameter :: one3d = 1.0D0 / 3.0D0 + Real( 8 ), Parameter :: two3d = 2.0D0 / 3.0D0 + + Real, Parameter :: one3 = 1.0 / 3.0 + Real, Parameter :: dgmin = 1.0E-09 ! minimum particle diameter [ m ] + Real, Parameter :: densmin = 1.0E03 ! minimum particle density [ kg/m**3 ] + + Real( 8 ) :: minl2sg( n_mode ) ! min value of ln(sg)**2 for each mode + Real( 8 ) :: maxl2sg( n_mode ) ! max value of ln(sg)**2 for each mode + + Real :: factor + Real( 8 ) :: sumM3 + Real( 8 ) :: sumMass + Integer :: n, spc ! loop counters + +C----------------------------------------------------------------------- + +C *** Set bounds for ln(Sg)**2 + + Do n = 1 , n_mode + If ( limit_sg ) Then + minl2sg( n ) = aeromode_sdev( n ) ** 2 + maxl2sg( n ) = aeromode_sdev( n ) ** 2 + Else + minl2sg( n ) = Log( min_sigma_g ) ** 2 + maxl2sg( n ) = Log( max_sigma_g ) ** 2 + End If + End Do + +C *** Calculate aerosol 3rd moment concentrations [ m**3 / m**3 ] + + Do n = 1, n_mode + sumM3 = 0.0 + sumMass = 0.0 + + Do spc = 1, n_aerospc + If ( aerospc( spc )%tracer ) Cycle + If ( aerospc( spc )%name( n ) .eq. ' ' ) Cycle + + If ( .Not. aerospc( spc )%no_M2Wet .Or. m3_wet_flag ) Then + factor = 1.0E-9 * f6pi / aerospc( spc )%density + sumM3 = sumM3 + factor * aerospc_conc( spc,n ) + sumMass = sumMass + aerospc_conc( spc,n ) + End If + End Do + + moment3_conc( n ) = Max (sumM3, Real( aeromode( n )%min_m3conc, 8 ) ) + aeromode_mass( n ) = sumMass + End Do + +C *** Calculate modal average particle densities [ kg/m**3 ] + + Do n = 1, n_mode + aeromode_dens( n ) = Max( densmin, + & 1.0E-9 * f6pi * aeromode_mass( n ) / moment3_conc( n ) ) + End Do + +C *** Calculate geometric standard deviations as follows: +c ln^2(Sg) = 1/3*ln(M0) + 2/3*ln(M3) - ln(M2) +c NOTES: +c 1. Equation 10-5a of [Binkowski:1999] and Equation 5a of +c Binkowski&Roselle(2003) contain typographical errors. +c 2. If the square of the logarithm of the geometric standard +c deviation is out of an acceptable range, reset this value and +c adjust the second moments to be consistent with this value. +c In this manner, M2 is artificially increased when Sg exceeds +c the maximum limit. M2 is artificially decreased when Sg falls +c below the minimum limit. + +C *** Aitken Mode: + + Do n = 1, n_mode + xxm0 = moment0_conc( n ) + xxm2 = moment2_conc( n ) + xxm3 = moment3_conc( n ) + + xfsum = one3d * Log( xxm0 ) + two3d * Log( xxm3 ) + + lxfm2 = Log( xxm2 ) + l2sg = xfsum - lxfm2 + + l2sg = Max( l2sg, minl2sg( n ) ) + l2sg = Min( l2sg, maxl2sg( n ) ) + + lxfm2 = xfsum - l2sg + moment2_conc( n ) = Exp ( lxfm2 ) + aeromode_sdev( n ) = Sqrt( l2sg ) + + ES36 = Exp( 4.5 * l2sg ) + aeromode_diam( n ) = Max( dgmin, ( moment3_conc( n ) + & / ( moment0_conc( n ) * es36 ) ) ** one3 ) + + End Do + + Return + End Subroutine getpar + diff --git a/models/CCTM/aero/blank/hetchem.f b/models/CCTM/aero/blank/hetchem.f new file mode 100755 index 0000000..6967de3 --- /dev/null +++ b/models/CCTM/aero/blank/hetchem.f @@ -0,0 +1,807 @@ + +!------------------------------------------------------------------------! +! 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, [locker] +C $Header: /project/yoj/arc/CCTM/src/aero/aero5/hetchem.f,v 1.7 2012/01/19 13:13:59 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HETCHEM( GAMMA, DT ) + +c Calculates the heterogeneous conversion of N2O5 to HNO3 by following +c the Model Description section by Pleim et al. (1995). + +c Key Subroutines Called: none +c +c Key Functions Called: N2O5PROB +c +c Revision History: +c First version was coded in November 2007 by Dr. Prakash Bhave +c using excerpts of the EQL3 subroutine in CMAQv4.6. Entries +c from the EQL3 revision history which are specific to the +c heterogeneous chemistry calculations have been copied here, to +c preserve that history in the event that the EQL3 subroutine is +c later removed from the aerosol code. +c +c FSB 10/23/01 Revised to include the heterogeneous reaction of N2O5 +c with aerosol to produce HNO3, based on Pleim et al +c (1995). AIRPRES & DT added to call vector. These +c modifications assume that GETPAR has been called prior +c to calling EQL3. It is also assumed that AH2OI and AH2OJ +c have been added to the transport routines. +c +c GLG 08/15/02 Revised to use radius instead of diameter in calculation +c of N2O5->HNO3 rate constant +c +c GLG 03/10/03 Revised to use composition-dependent gamma from Riemer +c et al. (2003) +c +c SJR 03/14/03 Revised to use the effective diameter in the calculation +c of N2O5->HNO3 rate constant instead of the geometric +c mean diameter +c +c SJR 04/15/03 Corrected units in the HNO3 yield from the heterogeneous +c N2O5 Rxn of Riemer et al. (2003) +c +c GS 04/04/06 Revised to use T,RH-dependent gamma from Evans & Jacob +c (2005). Retained ratio of GAMMA1/GAMMA2 from Riemer et +c al. (2003). +c +c PVB 04/06/06 Added GAMMA to the call vector, so it can be written +c to the aerosol diagnostic file. +c +c JOY 04/04/07 Optimized GAMMA calculation; initialized GAMMA in case +c RH < 1%; Note: some compilers recognize GAMMA as an +c intrinsic GAMMA function. +c +c PVB 11/06/07 Copied excerpts of the EQL3 subroutine to create this +c new subroutine. Moved all calculations of GAMMA to a +c function subprogram, N2O5PROB. Revised to use GAMMA +c parameterization of Davis et al (2008), by default. +c +c GS 03/31/08 Added a heterogeneous reaction producing HONO +c +c JTK 04/17/08 Moved molar mass and conversion factors to AERO_INFO.f +c +c SH 12/08/09 Use new Fortran modules (aero_data, precursor_data, +c met_data) in lieu of CBLK array and AERO_INFO module +c +c SH 03/10/11 Renamed met_data to aeromet_data +c +c REFERENCES: +c 1. Pleim, J.E., F.S. Binkowski, J.K.S. Ching, R.L. Dennis, and N.V. +c Gallani, An improved representation of the reaction of N2O5 on +c aerosols for mesoscale air quality models. In "Regional +c Photochemical Measurement and Modeling Studies, Vol 2 - Results +c and Status of Modeling," Eds A.J. Ranzieri and P.A. Solomon, pp +c 904-913, 1995. +c +c 2. Davis, J.M., P.V. Bhave, and K.M. Foley, Parameterization of N2O5 +c reaction probabilities on the surface of particles containing +c ammonium, sulfate, and nitrate. Atmos. Chem. Phys., 2008, in +c press. +c +c 3. Vogel, B., H. Vogel, J. Kleffman, and R. Kurtenbach, Measured and +c simulated vertical profiles of nitrous acid - Part II. Model +c simulations and indications for a photolytic source, Atmospheric +c Environment, 37, 2957-2966, 2003. +c +c 4. Sarwar, G., S.J. Roselle, R. Mathur, W. Appel, R.L. Dennis, and +c B. Vogel, A comparison of CMAQ HONO predictions with observations +c from the Northeast Oxidant and Particle Study, Atmospheric +c Environment, 2008, in press. +C----------------------------------------------------------------------- + + USE AERO_DATA + USE PRECURSOR_DATA + USE AEROMET_DATA ! Includes CONST.EXT + + IMPLICIT NONE + +C *** Arguments + REAL, INTENT( OUT ) :: GAMMA ! N2O5->NO3 rxn probability + REAL, INTENT( IN ) :: DT ! Synchronization time step + +C *** Parameters + REAL, PARAMETER :: STD_DIFF_N2O5 = 0.1E-4 ! molecular diffusivity + ! of N2O5 at 101325 Pa + ! and 273.15 K [m2/sec] + REAL, PARAMETER :: GPKG = 1.0E+03 ! g/kg unit conversion + +C *** Local Variables + +C *** chemical species concentrations + REAL GHNO3 ! gas-phase nitric acid [ug/m3] + REAL GN2O5 ! gas-phase dinitrogen pentoxide [ug/m3] + REAL GNO2 ! gas-phase NO2 [ug/m3] + REAL GHONO ! gas-phase HONO [ug/m3] + +C *** 2nd and 3rd moments before equilibration (without H2O) + REAL OLD_M3_I, OLD_M3_J + REAL OLD_M2_I, OLD_M2_J + +C *** variables for N2O5 + H2O -> 2 HNO3 conversion + REAL WET_M3_I, WET_M3_J ! M3 before equilibration w.H2O + REAL WET_M2_I, WET_M2_J ! M2 before equilibration w.H2O + REAL DG_AT_WET, DG_AC_WET ! Initial median diameter w.H2O + REAL DE_AT_WET, DE_AC_WET ! Initial effective diameter w.H2O + REAL XXF_AT, XXF_AC ! modal factors to calculate KN2O5 + REAL CBAR ! molecular velocity (m/s) + REAL DIFF_N2O5 ! ambient molecular diffusivity [m2/s] + REAL N2O5PROB ! function to compute GAMMA + REAL KN2O5 ! pseudo-first order rate constant + REAL EXPDT_N2O5 ! fraction of N2O5 left after chemical rxn + +C *** saved variables for conversion + REAL, SAVE :: FAERNO2 ! converts ug -> mol + REAL, SAVE :: FAERN2O5 ! converts ug -> mol + REAL, SAVE :: DFHNO3 ! converts mol -> ug + REAL, SAVE :: DFHONO ! converts mol -> ug + +C *** variables for 2 NO2 + H2O -> HONO + HNO3 conversion + REAL KNO2 ! pseudo-first order rate constant + REAL EXPDT_NO2 ! fraction of NO2 left after chemical rxn + REAL TOTSURFA ! aerosol surface area (m**2/m**3) + +C *** first time switch + LOGICAL, SAVE :: firstime = .true. + +C----------------------------------------------------------------------- + +C *** compute only on first pass + If ( firstime ) Then + firstime = .false. + FAERNO2 = 1.0E-6 / precursor_mw( NO2_IDX ) + FAERN2O5 = 1.0E-6 / precursor_mw( N2O5_IDX ) + DFHONO = precursor_mw( HONO_IDX ) / 1.0E-6 + DFHNO3 = precursor_mw( HNO3_IDX ) / 1.0E-6 + End If ! first time condition + +C *** fetch vapor-phase concentrations [ug/m3] + GHNO3 = precursor_conc( HNO3_IDX ) + GN2O5 = precursor_conc( N2O5_IDX ) + GNO2 = precursor_conc( NO2_IDX ) + GHONO = precursor_conc( HONO_IDX ) + +C *** set up variables needed for calculating KN2O5 + +C *** capture values of "dry" 2nd and 3rd moments before equilibration +C the folowing code assumes that GETPAR has been called with +C M3_WET_FLAG set to .FALSE. and that the 2nd and 3rd moments have +C been adjusted for the new SOA. + OLD_M3_I = moment3_conc( 1 ) + OLD_M3_J = moment3_conc( 2 ) + OLD_M2_I = moment2_conc( 1 ) + OLD_M2_J = moment2_conc( 2 ) + +C *** compute GAMMA as function of TEMP, RH, & particle composition +C Note: the last argument to this function can be changed to use +C a different parameterization of GAMMA. + GAMMA = N2O5PROB( AIRTEMP, AIRRH, 0 ) + +C *** calculate molecular speed (m/s) using Eq 4 of Pleim et al (1995) + CBAR = SQRT( 8.0 * RGASUNIV * AIRTEMP * GPKG + & / ( PI * precursor_mw( N2O5_IDX ) ) ) + +C *** correct molecular diffusivity for ambient conditions + DIFF_N2O5 = STD_DIFF_N2O5 + & * ( ( AIRTEMP / STDTEMP ) ** 1.75 ) + & * ( STDATMPA / AIRPRES ) + +C *** estimate the "wet third moments" by adding aerosol water +C Note: this is the H2O concentration from previous time step + WET_M3_I = OLD_M3_I + H2OFAC * aerospc_conc( AH2O_IDX,1 ) + WET_M3_J = OLD_M3_J + H2OFAC * aerospc_conc( AH2O_IDX,2 ) + +C *** calculate "wet second moment" assuming that H2O does not +C affect the geometric standard deviation + WET_M2_I = OLD_M2_I * ( WET_M3_I / OLD_M3_I ) ** ( 2.0 / 3.0 ) + WET_M2_J = OLD_M2_J * ( WET_M3_J / OLD_M3_J ) ** ( 2.0 / 3.0 ) + +C *** calculate "wet" geometric mean (same as median) diameters + DG_AT_WET = aeromode_diam( 1 ) * SQRT( WET_M2_I / OLD_M2_I ) + DG_AC_WET = aeromode_diam( 2 ) * SQRT( WET_M2_J / OLD_M2_J ) + +C *** calculate effective diameters using Eq 3 of Pleim et al (1995) + DE_AT_WET = DG_AT_WET * EXP( 1.5 + & * ( LOG( EXP( aeromode_sdev( 1 ) ) ) ** 2.0 ) ) + DE_AC_WET = DG_AC_WET * EXP( 1.5 + & * ( LOG( EXP( aeromode_sdev( 2 ) ) ) ** 2.0 ) ) + +C *** calculate pseudo-first order rate constant using Eq 2 of +C Pleim et al (1995) + XXF_AT = WET_M2_I / + & ( 4.0 + 0.5 * DE_AT_WET * GAMMA * CBAR / DIFF_N2O5 ) + XXF_AC = WET_M2_J / + & ( 4.0 + 0.5 * DE_AC_WET * GAMMA * CBAR / DIFF_N2O5 ) + KN2O5 = GAMMA * CBAR * PI * ( XXF_AT + XXF_AC ) + +C *** calculate fraction of N2O5 remaining after chemical reaction + EXPDT_N2O5 = EXP( - KN2O5 * DT ) + +C *** set up variables needed for calculating KNO2 + +C *** calculate aerosol surface area + TOTSURFA = ( WET_M2_I + WET_M2_J ) * PI + +C *** calculate pseudo-first order rate constant using Eq 1 of Vogel +C et al. (2003). Units of KNO2 is in 1/min in the paper; divide it +C by 60 to convert it into 1/sec + KNO2 = MAX ( 0.0, 5.0E-5 * TOTSURFA ) + +C *** calculate fraction of NO2 remaining after chemical reaction + EXPDT_NO2 = EXP( -2.0 * KNO2 * DT ) + +C *** compute new gas-phase concs after heterogeneous reactions occur + +C *** adjust nitrous acid for contribution from NO2 + GHONO = GHONO + & + ( 0.5 * GNO2 * FAERNO2 * DFHONO ) * ( 1.0 - EXPDT_NO2 ) + +C *** adjust nitric acid for contributions from N2O5 and NO2 + GHNO3 = GHNO3 + & + ( 2.0 * GN2O5 * FAERN2O5 * DFHNO3 ) * ( 1.0 - EXPDT_N2O5 ) + & + ( 0.5 * GNO2 * FAERNO2 * DFHNO3 ) * ( 1.0 - EXPDT_NO2 ) + +C *** adjust N2O5 for heterogeneous loss + GN2O5 = GN2O5 * EXPDT_N2O5 + +C *** adjust NO2 for heterogeneous loss + GNO2 = GNO2 * EXPDT_NO2 + +C *** UPDATE GAS and PM CONCENTRATIONS +C HNO3, N2O5, NO2, and HONO concs are changed in this subroutine. +C Ensure that all species remain above the minimum concentration. + precursor_conc( HNO3_IDX ) = MAX( GHNO3, CONMIN ) + precursor_conc( N2O5_IDX ) = MAX( GN2O5, CONMIN ) + precursor_conc( NO2_IDX ) = MAX( GNO2, CONMIN ) + precursor_conc( HONO_IDX ) = MAX( GHONO, CONMIN ) + + RETURN + + END SUBROUTINE HETCHEM + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + REAL FUNCTION N2O5PROB( TEMP, RH, GPARAM ) + +C Calculates the N2O5 heterogeneous reaction probability, which is the +C fraction of collisions between a gaseous N2O5 molecule and a particle +C surface that leads to nitrate production. In the literature, this +C probability is commonly referred to with the Greek letter, GAMMA. To +C avoid conflicts with the intrinsic GAMMA function on some compilers, +C we refer to the reaction probability as N2O5PROB in this function. + +C A variety of parameterizations of N2O5PROB are available in this +C function. Users may select among the different parameterizations +C by changing the input argument, GPARAM. This argument may take on +C the following values (see code for further details): +C 1. Constant value of 0.1 based on Dentener & Crutzen (1993) +C 2. Function of particle SO4 and NO3, based on Riemer et al. (2003) +C 3. Function of RH, Temp, and particle composition, based on a +C combination of parameterizations by Evans & Jacob (2005) and +C Riemer et al. (2003) +C If GPARAM matches none of the above values, the default calculation +C of N2O5PROB is a function of RH, T, particle composition, and phase +C state, based on the parameterization by Davis et al. (2008). + +C Key Subroutines Called: none + +C Key Functions Called: CRHB, IRHX + +C Revision History: +C First version was coded in November 2007 by Dr. Prakash Bhave +C using excerpts of the HETCHEM subroutine, which contained only +C one option for computing N2O5PROB (i.e., GPARAM = 3). +C +C PVB 11/03/07 Removed code that sets N2O5PROB to zero when RH < 1%. +C +C PVB 11/05/07 Corrected GPARAM = 3 option to fix the typographical +C error in the paper by Evans & Jacob (2005), which was +C found by Dr. Jerry Davis. +C +C PVB 04/11/08 Updated formulas for LAM1 & LAM2 based on revised paper +C by Davis et al. (2008). Added APNDX flag so users may +C switch between base parameterization and the alternative +C discussed in Appendix A by Davis et al. Set default +C parameterization to match equations in Appendix A. +C Reduced all regression coefficients by one decimal place +C for consistency with revised paper. +C +C JTK 04/17/08 Moved molar mass to AERO_INFO.f +C +C SH 12/08/09 Use new Fortran modules (aero_data, met_data) in lieu of +C CBLK array and AERO_INFO module +C +C SH 03/10/11 Renamed met_data to aeromet_data + +C References: +C 1. Dentener, F.J. and P.J. Crutzen, Reaction of N2O5 on tropospheric +C aerosols: Impact of global distributions of NOx, O3, and OH. +C J. Geophys. Res., Vol 98, 7149-7163, 1993. +C +C 2. Riemer, N., H. Vogel, B. Vogel, B. Schell, I. Ackermann, C. +C Kessler, and H. Hass, Impact of the heterogeneous hydrolysis +C of N2O5 on chemistry of nitrate aerosol formation in the lower +C troposphere under photosmog conditions. J. Geophys. Res., Vol +C 108, No D4, 4144, doi:10.1029/2002JD002436, 2003. +C +C 3. Evans, M.J. and D.J. Jacob, Impact of new laboratory studies of +C N2O5 hydrolysis on global model budgets of tropospheric nitrogen +C oxides, ozone, and OH. Geophys. Res. Lett., 32, L09813, +C doi:10.1029/2005GL022469, 2005. +C +C 4. Davis, J.M., P.V. Bhave, and K.M. Foley, Parameterization of N2O5 +C reaction probabilities on the surface of particles containing +C ammonium, sulfate, and nitrate. Atmos. Chem. Phys., 2008, in +C press. +C +C 5. Mentel, T.F., M. Sohn, and A. Wahner, Nitrate effect in the +C heterogeneous hydrolysis of dinitrogen pentoxide on aqueous +C aerosols. Phys. Chem. Chem. Phys., 1, 5451-5457, 1999. +C----------------------------------------------------------------------- + + USE AERO_DATA + USE AEROMET_DATA ! Includes CONST.EXT + + IMPLICIT NONE + +C *** Arguments + REAL, INTENT( IN ) :: TEMP ! Air temperature [ K ] + REAL, INTENT( IN ) :: RH ! Fractional relative humidity + INTEGER, INTENT( IN ) :: GPARAM ! switch to select among + ! parameterizations + +C *** Parameters + +C *** switch for alternative parameterization of LAM1 & LAM2 +C when APNDX = .TRUE. (default), Eqs A1-A2 are used for reaction +C probability on aqueous sulfate particles. Alternatively, set +C APNDX = .FALSE. to use Eqs 4-5. + LOGICAL, PARAMETER :: APNDX = .TRUE. + +C *** Local Variables + +C *** chemical species concentrations [ug/m3] + REAL ANH4 ! i+j mode ammonium + REAL ANO3 ! i+j mode nitrate + REAL ASO4 ! i+j mode sulfate + +C *** variables for computing N2O5PROB when GPARAM = 2 or 3 + REAL FRACSO4 ! aerosol mass ratio of SO4/(SO4+NO3) + REAL GAMMA1 ! upper limit of rxn prob + REAL GAMMA2 ! lower limit of rxn prob + REAL ALPHA ! RH-dependent parameter to compute GAMMA1 + REAL BETA ! TEMP-dependent parameter to compute GAMMA1 + +C *** variables for default parameterization of N2O5PROB + LOGICAL CRHB ! function to determine if RH is below CRH + LOGICAL CRYSTAL ! true if ambient RH < CRH, false otherwise + LOGICAL IRHX ! function to determine whether RH exceeds IRH + LOGICAL FROZEN ! true if ambient RH > IRH, false otherwise + REAL NNO3 ! particle-phase nitrate [micromoles/m3] + REAL NSO4 ! particle-phase sulfate [micromoles/m3] + REAL NNH4 ! particle-phase ammonium [micromoles/m3] + REAL NANI ! particle-phase anions [micromoles/m3] + REAL X1 ! mole fraction of ammonium bisulfate + REAL X2 ! mole fraction of ammonium sulfate + REAL X3 ! mole fraction of ammonium nitrate + REAL LAM1 ! logit transformation of N2O5PROB on + REAL LAM2 ! aqueous NH4HSO4 [LAM1], aqueous (NH4)2SO4 + REAL LAM3 ! [LAM2], aqueous NH4NO3 [LAM3], and dry + REAL LAMD ! sulfate-containing particles [LAMD] + REAL GAM1 ! reaction probability on aqueous NH4HSO4 + REAL GAM2 ! " " " " (NH4)2SO4 + REAL GAM3 ! " " " " NH4NO3 + REAL GAMD ! " " " dry sulfate particles + REAL T293,T291 ! temperature threshold variables + REAL RH46 ! RH threshold variable + +C *** statement function for inverting the logit transformation given +C in Eq 7 by Davis et al (2008) + REAL LOGITINV ! statement function + REAL XX ! dummy argument for LOGITINV + LOGITINV( XX ) = 1.0 / ( 1.0 + EXP( -XX ) ) + +C----------------------------------------------------------------------- + +C *** retrieve particle-phase ammonium, nitrate, and sulfate [ug/m3] + ANH4 = aerospc_conc( ANH4_IDX,1 ) + aerospc_conc( ANH4_IDX,2 ) + ANO3 = aerospc_conc( ANO3_IDX,1 ) + aerospc_conc( ANO3_IDX,2 ) + ASO4 = aerospc_conc( ASO4_IDX,1 ) + aerospc_conc( ASO4_IDX,2 ) + +C *** User Option: GPARAM = 1 +C Dentener and Crutzen (1993) recommended a constant value of +C N2O5PROB = 0.1, which was used in CMAQ prior to ver4.3. In more +C recent literature, this value has been recognized as an upper +C estimate of N2O5PROB so it should not be used for routine +C simulations. It is included here only to facilitate sensitivity +C studies by CMAQ model users. + IF ( GPARAM .EQ. 1 ) THEN + N2O5PROB = 0.1 + RETURN + END IF + +C *** User Options: GPARAM = 2 and 3 +C These options both employ Eqs 2 and 3 by Riemer et al (2003), in +C which N2O5PROB varies according to the particle-phase sulfate and +C nitrate concentrations. In both options, the NO3 effect (i.e., +C GAMMA1/GAMMA2) is assumed to be a factor of 10 based on Mentel et +C al (1999) and Riemer et al (2003). +C - When GPARAM = 2, upper limit of N2O5PROB is fixed at 0.02. +C This was the default setting in CMAQ ver4.3 through ver4.5.1. +C - When GPARAM = 3, upper limit of N2O5PROB is a function of +C ambient TEMP & RH based on the "Sulfate" equation in Table 1 +C by Evans & Jacob (2005). This was the default setting in CMAQ +C ver4.6. After that release, a typographical error was found +C in the published equation of Evans & Jacob (2005) so this code +C has been corrected accordingly. + IF ( GPARAM .EQ. 2 ) THEN + + GAMMA1 = 0.02 + + ELSE IF ( GPARAM .EQ. 3 ) THEN + +C In this function, RH is in fractional units whereas the +C published equation by Evans&Jacob refers to RH as a percentage. + ALPHA = 2.79E-4 + RH * ( 1.3E-2 + RH * ( -3.43E-2 + 7.52E-2 * RH ) ) + +C To fix the typographical error by Evans & Jacob (2005), the +C sign of BETA has been switched in this code. + IF ( TEMP .LT. 282.0 ) THEN + GAMMA1 = 3.0199517 * ALPHA ! (10.0 ** 0.48) * ALPHA + ELSE + BETA = 0.04 * ( 294.0 - TEMP ) + GAMMA1 = ALPHA * ( 10.0 ** BETA ) + END IF + + END IF + + IF ( ( GPARAM .EQ. 2 ) .OR. ( GPARAM .EQ. 3 ) ) THEN + + IF ( ANO3 .GT. 0.0 ) THEN + FRACSO4 = ASO4 / ( ASO4 + ANO3 ) + ELSE + FRACSO4 = 1.0 + END IF + + GAMMA2 = 0.1 * GAMMA1 + N2O5PROB = GAMMA2 + FRACSO4 * ( GAMMA1 - GAMMA2 ) + RETURN + + END IF + +C *** Default setting in current version of CMAQ: +C This code implements the paramaterization given in Eq 15 by Davis +C et al (2008), in which N2O5PROB is a function of RH, TEMP, +C particle composition, and phase state. Note: In this function, RH +C is in fractional units whereas the published equations refer to RH +C as a percentage. + +C *** Check whether the ambient RH is below the crystallization RH for +C the given inorganic particle composition. + CRYSTAL = CRHB( RH, .TRUE. ) + +C *** Check whether the ambient RH exceeds the RH of ice formation. + FROZEN = IRHX( TEMP, RH ) + +C *** Set N2O5PROB to constant value if particles contain ice, based on +C Eq 14 by Davis et al (2008). + IF ( FROZEN ) THEN + N2O5PROB = 0.02 ! Eq 14 + +C *** Compute mole-fractional-composition of particles based on Eq 11 by +C Davis et al (2008). + ELSE + NNO3 = ANO3 / aerospc_mw( ANO3_IDX ) + NSO4 = ASO4 / aerospc_mw( ASO4_IDX ) + NNH4 = ANH4 / aerospc_mw( ANH4_IDX ) + NANI = NNO3 + NSO4 + + X3 = NNO3 / NANI + X2 = MAX( 0.0, MIN( 1.0 - X3, NNH4/NANI - 1.0 ) ) + X1 = 1.0 - ( X2 + X3 ) + +C *** Compute N2O5PROB on pure NH4NO3 particles using Eqs 6 and 8 by +C Davis et al (2008). + LAM3 = -8.10774 + 4.902 * RH ! Eq 6 + GAM3 = MIN( LOGITINV( LAM3 ), 0.0154 ) ! Eq 8 + +C *** Compute N2O5PROB on dry particles using Eqs 9, 10, and 13 by +C Davis et al (2008). + IF ( CRYSTAL ) THEN + T293 = MAX( 0.0, TEMP - 293.0 ) + LAMD = -6.13376 + 3.592 * RH ! Eq 9 + & - 0.19688 * T293 + GAMD = MIN( LOGITINV( LAMD ), 0.0124 ) ! Eq 10 + N2O5PROB = ( X1 + X2 ) * GAMD ! Eq 13 + & + X3 * MIN( GAMD, GAM3 ) + +C *** Compute N2O5PROB on aqeuous particles using Eqs A1, A2, 8, and 12 +C by Davis et al (2008). When APNDX = .TRUE. (default), Eqs A1-A2 +C are used for reaction probability on aqueous sulfate particles. +C Switch to .FALSE. if Eqs 4-5 are desired. See Appendix A by +C Davis et al. (2008) for a discussion of these options. + ELSE + T291 = MAX( 0.0, TEMP - 291.0 ) + IF ( APNDX ) THEN + RH46 = MIN( 0.0, RH - 0.46 ) + LAM2 = -3.64849 + 9.553 * RH46 ! Eq A2 + LAM1 = LAM2 + 0.97579 ! Eqs A1 & A2 + & - 0.20427 * T291 + ELSE + LAM1 = -4.10612 + 2.386 * RH ! Eq 4 + & - 0.23771 * T291 + LAM2 = LAM1 - 0.80570 ! Eqs 4 & 5 + & + 0.10225 * T291 + END IF + GAM1 = MIN( LOGITINV( LAM1 ), 0.08585 )! Eq 8 + GAM2 = MIN( LOGITINV( LAM2 ), 0.053 ) ! Eq 8 + N2O5PROB = ( X1 * GAM1 ) ! Eq 12 + & + ( X2 * GAM2 ) + & + ( X3 * GAM3 ) + + END IF + + END IF + + RETURN + + END FUNCTION N2O5PROB + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + LOGICAL FUNCTION CRHB( RH, COMPLETE ) + +C Determines whether the ambient RH is below the crystallization relative +C humidity (CRH). The output of this logical function is .TRUE. when the +C ambient RH is below the CRH and .FALSE. otherwise. The empirical +C equations developed by Martin et al (2003) are applied to determine the +C CRH for a given mixture of sulfate, nitrate, and ammonium. Though those +C equations are validated only at 293K, they are applied at all ambient +C temperatures because insufficient data exist to estimate the temperature +C dependence of the CRH of mixed sulfate-nitrate-ammonium particles. +C Users can opt to compute either the RH of initial crystal formation +C (i.e., COMPLETE .EQ. .FALSE.) or the RH of compete crystallization (i.e., +C COMPLETE .EQ. .TRUE.). + +C References: +C 1. Martin, S.T., J.C. Schlenker, A. Malinowski, H.-M. Hung, and +C Y. Rudich, Crystallization of atmospheric sulfate-nitrate- +C ammonium particles. Geophys. Res. Lett., 30(21), 2102, +C doi:10.1029/2003GL017930, 2003. + +C Revision History: +C PVB 11/05/07 Coded the first version. +C JTK 04/17/08 Moved molar mass to AERO_INFO.f +C SH 12/08/09 Use aero_data module in lieu of CBLK array + +C----------------------------------------------------------------------- + + USE aero_data + + IMPLICIT NONE + +C *** Arguments + REAL, INTENT( IN ) :: RH ! fractional relative humidity + LOGICAL, INTENT( IN ) :: COMPLETE ! flag deciding which CRH + ! equation to use + +C *** Local Variables + +C *** chemical species concentrations [micromoles/m3] + REAL NSO4 ! i+j mode sulfate + REAL NNO3 ! i+j mode nitrate + REAL NNH4 ! i+j mode ammonium + REAL NCAT ! i+j mode cations + REAL NANI ! i+j mode anions + +C *** cation and anion mole fractions used in CRH equations + REAL X ! ammonium/cation mole fraction: NH4/(NH4+H) + REAL Y ! sulfate/anion mole fraction: SO4/(SO4+NO3) + +C *** intermediate variables used in CRH equations + REAL X2, XY, Y2, X2Y, XY2, RDEN + + REAL CRH ! crystallization RH (fractional units) + +C----------------------------------------------------------------------- + +C *** Experimental measurements of CRH are lacking below 1% relative +C humidity. Under those very dry conditions, we assume that +C particles will crystallize. Equations by Martin et al (2003) for +C internally-mixed sulfate-nitrate-ammonium particles yield maximum +C CRH values of 35.03% and 34.50% for initial crystal formation and +C complete crystallization, respectively. Therefore, the full CRH +C calculation can be avoided when RH > 35.1%. + IF ( RH .LE. 0.01 ) THEN + CRHB = .TRUE. ! ambient particles are dry + RETURN + ELSE IF ( RH .GT. 0.351 ) THEN + CRHB = .FALSE. ! ambient RH exceeds CRH + RETURN + END IF + +C *** calculate total particle-phase composition [micromoles/m3] + NNO3 = ( aerospc_conc( ANO3_IDX,1 ) + aerospc_conc( ANO3_IDX,2 ) ) + & / aerospc_mw( ANO3_IDX ) + NSO4 = ( aerospc_conc( ASO4_IDX,1 ) + aerospc_conc( ASO4_IDX,2 ) ) + & / aerospc_mw( ASO4_IDX ) + NNH4 = ( aerospc_conc( ANH4_IDX,1 ) + aerospc_conc( ANH4_IDX,2 ) ) + & / aerospc_mw( ANH4_IDX ) + +C *** calculate total anion and cation concentrations + NCAT = MAX( NNH4, 2.0 * NSO4 + NNO3 ) + NANI = NNO3 + NSO4 + +C *** calculate ammonium and sulfate mole fractions + X = NNH4 / NCAT + Y = NSO4 / NANI + +C *** Experimental data of Martin et al. (2003) show no crystal +C formation when X < 0.50 or Y < 0.22. For these particle +C compositions, the full CRH calculation can be avoided. +C +C Note: Martin's equation for initial crystal formation returns +C very large CRH values when X and Y approach zero. However, +C those values were verified to be erroneous by personal +C communication with Dr. Scot Martin on Aug. 30, 2007. + IF ( ( X .LT. 0.50 ) .OR. ( Y .LT. 0.22 ) ) THEN + CRHB = .FALSE. ! ambient RH exceeds CRH + RETURN + END IF + +C *** store some terms needed to evaluate the CRH equations + X2 = X * X + XY = X * Y + X2Y = X2 * Y + Y2 = Y * Y + XY2 = X * Y2 + RDEN = 1.0 / ( 25.0 + ( X - 0.7 ) * ( Y - 0.5 ) ) + +C *** calculate CRH using empirical equations of Martin et al (2003) + IF ( COMPLETE ) THEN + + CRH = 3143.44 + (63.07 * X) + (0.114 * X2) + (87.97 * Y) + & - (125.73 * XY) + (0.586 * X2Y) + (0.95 * Y2) + & - (1.384 * XY2) - (79692.5 * RDEN) + + ELSE + + CRH = -697.908 - (15.351 * X) + (0.43 * X2) - (22.11 * Y) + & + (33.882 * XY) - (1.818 * X2Y) + (0.772 * Y2) + & - (1.636 * XY2) + (17707.6 * RDEN) + + END IF + +C *** set value of the output variable, CRHB + IF ( RH .LE. CRH ) THEN + CRHB = .TRUE. ! ambient particles are dry + ELSE + CRHB = .FALSE. ! ambient RH exceeds CRH + END IF + + RETURN + + END FUNCTION CRHB + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + LOGICAL FUNCTION IRHX( TEMP, RH ) + +C Determines whether the ambient RH has exceeded the RH of ice formation, +C based on the Goff-Gratch equations as given by List (1984). + +C References: +C 1. Goff, J.A. and S. Gratch, Low-pressure properties of water from +C -160 to 212 F, in Transactions of the American Society of Heating +C and Ventilating Engineers, pp 95-122, New York, 1946. +C 2. List, R.J. (editor), Smithsonian Meteorological Tables, 5th ed. +C pp. 350, 1984. + +C Revision History: +C PVB 11/06/07 Coded the first version. +C----------------------------------------------------------------------- + + IMPLICIT NONE + +C *** Arguments + REAL, INTENT( IN ) :: TEMP ! Air temperature [ K ] + REAL, INTENT( IN ) :: RH ! Fractional relative humidity + +C *** Parameters + +C *** The following values are taken from List (1984). Note that +C these differ slightly from the original equations published by +C Goff & Gratch (1946). We also note that T0 and PST differ +C slightly from STDTEMP and STDATMPA in the AERO_INFO module. +C Here, we use 273.16 K and 1013.246 hPa to be consistent with +C the Goff-Gratch equations as given by List (1984). + REAL, PARAMETER :: TST = 373.16 ! steam-point temperature, K + REAL, PARAMETER :: T0 = 273.16 ! ice-point temperature, K + REAL, PARAMETER :: PST = 1013.246 ! sat vapor pres at TST, hPa + REAL, PARAMETER :: P0 = 6.1071 ! sat vapor pres at T0, hPa + + REAL, PARAMETER :: LOGPST = 3.0057149 ! LOG10(PST) + REAL, PARAMETER :: LOGP0 = 0.78583503 ! LOG10(P0) + +C *** Local Variables + +C *** estimates of IRH using a polynomial approximation + REAL EIRH ! IRH approximated using 2nd order polynomial + REAL LIRH ! lower-bound of IRH + REAL UIRH ! upper-bound of IRH + +C *** variables used to compute RH of ice formation + REAL TSDT, TDTS, T0DT, TDT0 ! intermediate variables + REAL LOGPW ! log10 of saturation vapor pressure over H2O + REAL LOGPI ! log10 of saturation vapor pressure over ice + + REAL IRH ! fractional RH at which ice forms + +C----------------------------------------------------------------------- + + IF ( TEMP .LT. T0 ) THEN + +C *** To mitigate the computational expense associated with Goff-Gratch +C equations, use a 2nd order polynomial function to approximate IRH. +C This approximation, EIRH, matches IRH from the full Goff-Gratch +C equations within 0.004 over the entire low-temperature range of +C interest (200 to 275K) and is used for screening purposes. + EIRH = 1.61299 + TEMP * ( 4.4117437E-5 * TEMP - 1.4293888E-2 ) + LIRH = EIRH - 0.005 + UIRH = EIRH + 0.005 + + IF ( RH .GT. UIRH ) THEN + IRHX = .TRUE. + ELSE IF ( RH .LT. LIRH ) THEN + IRHX = .FALSE. + ELSE + +C *** Compute IRH using Goff-Gratch equations as given by List (1984) + TSDT = TST / TEMP + TDTS = TEMP / TST + T0DT = T0 / TEMP + TDT0 = TEMP / T0 + LOGPW = -7.90298 * ( TSDT - 1.0 ) + & + 5.02808 * LOG10( TSDT ) + & - 1.3816E-7 * ( 10.0 ** ( 11.344 * (1.0 - TDTS) ) -1.0 ) + & + 8.1328E-3 * ( 10.0 ** ( -3.49149* (TSDT - 1.0) ) -1.0 ) + & + LOGPST + LOGPI = -9.09718 * (T0DT - 1.0) + & - 3.56654 * LOG10( T0DT ) + & + .876793 * (1.0 - TDT0) + & + LOGP0 + IRH = 10.0 ** ( LOGPI - LOGPW ) + + IF ( RH .GT. IRH ) THEN + IRHX = .TRUE. + ELSE + IRHX = .FALSE. + END IF + + END IF + ELSE + IRHX = .FALSE. + END IF + + RETURN + + END FUNCTION IRHX + diff --git a/models/CCTM/aero/blank/isocom.f b/models/CCTM/aero/blank/isocom.f new file mode 100755 index 0000000..a589740 --- /dev/null +++ b/models/CCTM/aero/blank/isocom.f @@ -0,0 +1,18386 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/isocom.f,v 1.2 2011/10/21 16:10:04 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C This is ISORROPIA Version 1.7 (3/15/06). More information is available +C at the ISORROPIA homepage: http://nenes.eas.gatech.edu/ISORROPIA/ +C It has been modified in the following ways: +C 1. A bug in how Kusik-Meissner binary activity coefficients are adjusted +C for temperatures other than 298 K was identified and corrected in +C version 1.7. This necessitated recomputing the tabulated coefficients +C in BLOCK DATA KMCF273. +C 2. In SUBROUTINE CALCACT, the "under-relaxation factor" adjustment has +C been commented out. +C 3. Also in SUBROUTINE CALCACT, EXP(LN10 * x) is used instead of 10 ** x +C for computational efficiency. This has no impact on results. +C 4. In SUBROUTINE POLY3, the double precision value of PI has been corrected. +C Tests indicate that this change also has no impact on results. +C +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISOROPIA +C *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA +C THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSION 1.1 and above) +C +C ======================== ARGUMENTS / USAGE =========================== +C +C INPUT: +C 1. [WI] +C DOUBLE PRECISION array of length [5]. +C Concentrations, expressed in moles/m3. Depending on the type of +C problem solved (specified in CNTRL(1)), WI contains either +C GAS+AEROSOL or AEROSOL only concentratios. +C WI(1) - sodium +C WI(2) - sulfate +C WI(3) - ammonium +C WI(4) - nitrate +C WI(5) - chloride +C +C 2. [RHI] +C DOUBLE PRECISION variable. +C Ambient relative humidity expressed on a (0,1) scale. +C +C 3. [TEMPI] +C DOUBLE PRECISION variable. +C Ambient temperature expressed in Kelvins. +C +C 4. [CNTRL] +C DOUBLE PRECISION array of length [2]. +C Parameters that control the type of problem solved. +C +C CNTRL(1): Defines the type of problem solved. +C 0 - Forward problem is solved. In this case, array WI contains +C GAS and AEROSOL concentrations together. +C 1 - Reverse problem is solved. In this case, array WI contains +C AEROSOL concentrations only. +C +C CNTRL(2): Defines the state of the aerosol +C 0 - The aerosol can have both solid+liquid phases (deliquescent) +C 1 - The aerosol is in only liquid state (metastable aerosol) +C +C OUTPUT: +C 1. [WT] +C DOUBLE PRECISION array of length [5]. +C Total concentrations (GAS+AEROSOL) of species, expressed in moles/m3. +C If the foreward probelm is solved (CNTRL(1)=0), array WT is +C identical to array WI. +C WT(1) - total sodium +C WT(2) - total sulfate +C WT(3) - total ammonium +C WT(4) - total nitrate +C WT(5) - total chloride +C +C 2. [GAS] +C DOUBLE PRECISION array of length [03]. +C Gaseous species concentrations, expressed in moles/m3. +C GAS(1) - NH3 +C GAS(2) - HNO3 +C GAS(3) - HCl +C +C 3. [AERLIQ] +C DOUBLE PRECISION array of length [11]. +C Liquid aerosol species concentrations, expressed in moles/m3. +C AERLIQ(01) - H+(aq) +C AERLIQ(02) - Na+(aq) +C AERLIQ(03) - NH4+(aq) +C AERLIQ(04) - Cl-(aq) +C AERLIQ(05) - SO4--(aq) +C AERLIQ(06) - HSO4-(aq) +C AERLIQ(07) - NO3-(aq) +C AERLIQ(08) - H2O +C AERLIQ(09) - NH3(aq) (undissociated) +C AERLIQ(10) - HNCl(aq) (undissociated) +C AERLIQ(11) - HNO3(aq) (undissociated) +C AERLIQ(12) - OH-(aq) +C +C 4. [AERSLD] +C DOUBLE PRECISION array of length [09]. +C Solid aerosol species concentrations, expressed in moles/m3. +C AERSLD(01) - NaNO3(s) +C AERSLD(02) - NH4NO3(s) +C AERSLD(03) - NaCl(s) +C AERSLD(04) - NH4Cl(s) +C AERSLD(05) - Na2SO4(s) +C AERSLD(06) - (NH4)2SO4(s) +C AERSLD(07) - NaHSO4(s) +C AERSLD(08) - NH4HSO4(s) +C AERSLD(09) - (NH4)4H(SO4)2(s) +C +C 5. [SCASI] +C CHARACTER*15 variable. +C Returns the subcase which the input corresponds to. +C +C 6. [OTHER] +C DOUBLE PRECISION array of length [6]. +C Returns solution information. +C +C OTHER(1): Shows if aerosol water exists. +C 0 - Aerosol is WET +C 1 - Aerosol is DRY +C +C OTHER(2): Aerosol Sulfate ratio, defined as (in moles/m3) : +C (total ammonia + total Na) / (total sulfate) +C +C OTHER(3): Sulfate ratio based on aerosol properties that defines +C a sulfate poor system: +C (aerosol ammonia + aerosol Na) / (aerosol sulfate) +C +C OTHER(4): Aerosol sodium ratio, defined as (in moles/m3) : +C (total Na) / (total sulfate) +C +C OTHER(5): Ionic strength of the aqueous aerosol (if it exists). +C +C OTHER(6): Total number of calls to the activity coefficient +C calculation subroutine. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISOROPIA (WI, RHI, TEMPI, CNTRL, + & WT, GAS, AERLIQ, AERSLD, SCASI, OTHER) + INCLUDE 'isrpia.inc' + PARAMETER (NCTRL=2,NOTHER=6) + CHARACTER SCASI*15 + DIMENSION WI(NCOMP), WT(NCOMP), GAS(NGASAQ), AERSLD(NSLDS), + & AERLIQ(NIONS+NGASAQ+2), CNTRL(NCTRL), OTHER(NOTHER) +C +C *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ****************************** +C + IPROB = NINT(CNTRL(1)) +C +C *** AEROSOL STATE (0=SOLID+LIQUID, 1=METASTABLE) ********************** +C + METSTBL = NINT(CNTRL(2)) +C +C *** SOLVE FOREWARD PROBLEM ******************************************** +C +50 IF (IPROB.EQ.0) THEN + IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0 + CALL INIT1 (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN ! Na,Cl,NO3=0 + CALL ISRP1F (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(5) .LE. TINY) THEN ! Na,Cl=0 + CALL ISRP2F (WI, RHI, TEMPI) + ELSE + CALL ISRP3F (WI, RHI, TEMPI) + ENDIF +C +C *** SOLVE REVERSE PROBLEM ********************************************* +C + ELSE + IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0 + CALL INIT1 (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN ! Na,Cl,NO3=0 + CALL ISRP1R (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(5) .LE. TINY) THEN ! Na,Cl=0 + CALL ISRP2R (WI, RHI, TEMPI) + ELSE + CALL ISRP3R (WI, RHI, TEMPI) + ENDIF + ENDIF +C +C *** ADJUST MASS BALANCE *********************************************** +C + IF (NADJ.EQ.1) CALL ADJUST (WI) +ccC +ccC *** IF METASTABLE AND NO WATER - RESOLVE AS NORMAL ******************** +ccC +cc IF (WATER.LE.TINY .AND. METSTBL.EQ.1) THEN +cc METSTBL = 0 +cc GOTO 50 +cc ENDIF +C +C *** SAVE RESULTS TO ARRAYS (units = mole/m3) **************************** +C + GAS(1) = GNH3 ! Gaseous aerosol species + GAS(2) = GHNO3 + GAS(3) = GHCL +C + DO 10 I=1,NIONS ! Liquid aerosol species + AERLIQ(I) = MOLAL(I) + 10 CONTINUE + DO 20 I=1,NGASAQ + AERLIQ(NIONS+1+I) = GASAQ(I) + 20 CONTINUE + AERLIQ(NIONS+1) = WATER*1.0D3/18.0D0 + AERLIQ(NIONS+NGASAQ+2) = COH +C + AERSLD(1) = CNANO3 ! Solid aerosol species + AERSLD(2) = CNH4NO3 + AERSLD(3) = CNACL + AERSLD(4) = CNH4CL + AERSLD(5) = CNA2SO4 + AERSLD(6) = CNH42S4 + AERSLD(7) = CNAHSO4 + AERSLD(8) = CNH4HS4 + AERSLD(9) = CLC +C + IF(WATER.LE.TINY) THEN ! Dry flag + OTHER(1) = 1.d0 + ELSE + OTHER(1) = 0.d0 + ENDIF +C + OTHER(2) = SULRAT ! Other stuff + OTHER(3) = SULRATW + OTHER(4) = SODRAT + OTHER(5) = IONIC + OTHER(6) = ICLACT +C + SCASI = SCASE +C + WT(1) = WI(1) ! Total gas+aerosol phase + WT(2) = WI(2) + WT(3) = WI(3) + WT(4) = WI(4) + WT(5) = WI(5) + IF (IPROB.GT.0 .AND. WATER.GT.TINY) THEN + WT(3) = WT(3) + GNH3 + WT(4) = WT(4) + GHNO3 + WT(5) = WT(5) + GHCL + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE ISOROPIA ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE SETPARM +C *** THIS SUBROUTINE REDEFINES THE SOLUTION PARAMETERS OF ISORROPIA +C +C ======================== ARGUMENTS / USAGE =========================== +C +C *** NOTE: IF NEGATIVE VALUES ARE GIVEN FOR A PARAMETER, IT IS +C IGNORED AND THE CURRENT VALUE IS USED INSTEAD. +C +C INPUT: +C 1. [WFTYPI] +C INTEGER variable. +C Defines the type of weighting algorithm for the solution in Mutual +C Deliquescence Regions (MDR's): +C 0 - MDR's are assumed dry. This is equivalent to the approach +C used by SEQUILIB. +C 1 - The solution is assumed "half" dry and "half" wet throughout +C the MDR. +C 2 - The solution is a relative-humidity weighted mean of the +C dry and wet solutions (as defined in Nenes et al., 1998) +C +C 2. [IACALCI] +C INTEGER variable. +C Method of activity coefficient calculation: +C 0 - Calculate coefficients during runtime +C 1 - Use precalculated tables +C +C 3. [EPSI] +C DOUBLE PRECITION variable. +C Defines the convergence criterion for all iterative processes +C in ISORROPIA, except those for activity coefficient calculations +C (EPSACTI controls that). +C +C 4. [MAXITI] +C INTEGER variable. +C Defines the maximum number of iterations for all iterative +C processes in ISORROPIA, except for activity coefficient calculations +C (NSWEEPI controls that). +C +C 5. [NSWEEPI] +C INTEGER variable. +C Defines the maximum number of iterations for activity coefficient +C calculations. +C +C 6. [EPSACTI] +C DOUBLE PRECISION variable. +C Defines the convergence criterion for activity coefficient +C calculations. +C +C 7. [NDIV] +C INTEGER variable. +C Defines the number of subdivisions needed for the initial root +C tracking for the bisection method. Usually this parameter should +C not be altered, but is included for completeness. +C +C 8. [NADJ] +C INTEGER variable. +C Forces the solution obtained to satisfy total mass balance +C to machine precision +C 0 - No adjustment done (default) +C 1 - Do adjustment +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE SETPARM (WFTYPI, IACALCI, EPSI, MAXITI, NSWEEPI, + & EPSACTI, NDIVI, NADJI) + INCLUDE 'isrpia.inc' + INTEGER WFTYPI +C +C *** SETUP SOLUTION PARAMETERS ***************************************** +C + IF (WFTYPI .GE. 0) WFTYP = WFTYPI + IF (IACALCI.GE. 0) IACALC = IACALCI + IF (EPSI .GE.ZERO) EPS = EPSI + IF (MAXITI .GT. 0) MAXIT = MAXITI + IF (NSWEEPI.GT. 0) NSWEEP = NSWEEPI + IF (EPSACTI.GE.ZERO) EPSACT = EPSACTI + IF (NDIVI .GT. 0) NDIV = NDIVI + IF (NADJI .GE. 0) NADJ = NADJI +C +C *** END OF SUBROUTINE SETPARM ***************************************** +C + RETURN + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE GETPARM +C *** THIS SUBROUTINE OBTAINS THE CURRENT VAULES OF THE SOLUTION +C PARAMETERS OF ISORROPIA +C +C ======================== ARGUMENTS / USAGE =========================== +C +C *** THE PARAMETERS ARE THOSE OF SUBROUTINE SETPARM +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE GETPARM (WFTYPI, IACALCI, EPSI, MAXITI, NSWEEPI, + & EPSACTI, NDIVI, NADJI) + INCLUDE 'isrpia.inc' + INTEGER WFTYPI +C +C *** GET SOLUTION PARAMETERS ******************************************* +C + WFTYPI = WFTYP + IACALCI = IACALC + EPSI = EPS + MAXITI = MAXIT + NSWEEPI = NSWEEP + EPSACTI = EPSACT + NDIVI = NDIV + NADJI = NADJ +C +C *** END OF SUBROUTINE GETPARM ***************************************** +C + RETURN + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** BLOCK DATA BLKISO +C *** THIS SUBROUTINE PROVIDES INITIAL (DEFAULT) VALUES TO PROGRAM +C PARAMETERS VIA DATA STATEMENTS +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C *** ZSR RELATIONSHIP PARAMETERS MODIFIED BY DOUGLAS WALDRON +C *** OCTOBER 2003 +C *** BASED ON AIM MODEL III (http://mae.ucdavis.edu/wexler/aim) +C +C======================================================================= +C + BLOCK DATA BLKISO + INCLUDE 'isrpia.inc' +C +C *** DEFAULT VALUES ************************************************* +C + DATA TEMP/298.0/, R/82.0567D-6/, RH/0.9D0/, EPS/1D-6/, MAXIT/100/, + & TINY/1D-20/, GREAT/1D10/, ZERO/0.0D0/, ONE/1.0D0/,NSWEEP/4/, + & TINY2/1D-11/,NDIV/5/ +C + DATA MOLAL/NIONS*0.0D0/, MOLALR/NPAIR*0.0D0/, GAMA/NPAIR*0.1D0/, + & GAMOU/NPAIR*1D10/, GAMIN/NPAIR*1D10/, CALAIN/.TRUE./, + & CALAOU/.TRUE./, EPSACT/5D-2/, ICLACT/0/, + & IACALC/1/, NADJ/0/, WFTYP/2/ +C + DATA ERRSTK/NERRMX*0/, ERRMSG/NERRMX*' '/, NOFER/0/, + & STKOFL/.FALSE./ +C + DATA IPROB/0/, METSTBL/0/ +C + DATA VERSION /'1.7 (03/15/06)'/ +C +C *** OTHER PARAMETERS *********************************************** +C + DATA SMW/58.5,142.,85.0,132.,80.0,53.5,98.0,98.0,115.,63.0, + & 36.5,120.,247./ + & IMW/ 1.0,23.0,18.0,35.5,96.0,97.0,63.0/, + & WMW/23.0,98.0,17.0,63.0,36.5/ +C + DATA ZZ/1,2,1,2,1,1,2,1,1,1,1,1,2/, Z /1,1,1,1,2,1,1/ +C +C *** ZSR RELATIONSHIP PARAMETERS ************************************** +C +C awas= ammonium sulfate +C + DATA AWAS/10*187.72, + & 158.13,134.41,115.37,100.10, 87.86, 78.00, 70.00, 63.45, 58.02, + & 53.46, + & 49.59, 46.26, 43.37, 40.84, 38.59, 36.59, 34.79, 33.16, 31.67, + & 30.31, + & 29.07, 27.91, 26.84, 25.84, 24.91, 24.03, 23.21, 22.44, 21.70, + & 21.01, + & 20.34, 19.71, 19.11, 18.54, 17.99, 17.46, 16.95, 16.46, 15.99, + & 15.54, + & 15.10, 14.67, 14.26, 13.86, 13.47, 13.09, 12.72, 12.36, 12.01, + & 11.67, + & 11.33, 11.00, 10.68, 10.37, 10.06, 9.75, 9.45, 9.15, 8.86, + & 8.57, + & 8.29, 8.01, 7.73, 7.45, 7.18, 6.91, 6.64, 6.37, 6.10, + & 5.83, + & 5.56, 5.29, 5.02, 4.74, 4.47, 4.19, 3.91, 3.63, 3.34, + & 3.05, + & 2.75, 2.45, 2.14, 1.83, 1.51, 1.19, 0.87, 0.56, 0.26, + & 0.1/ +C +C awsn= sodium nitrate +C + DATA AWSN/10*394.54, + & 338.91,293.01,254.73,222.61,195.56,172.76,153.53,137.32,123.65, + & 112.08, + & 102.26, 93.88, 86.68, 80.45, 75.02, 70.24, 66.02, 62.26, 58.89, + & 55.85, + & 53.09, 50.57, 48.26, 46.14, 44.17, 42.35, 40.65, 39.06, 37.57, + & 36.17, + & 34.85, 33.60, 32.42, 31.29, 30.22, 29.20, 28.22, 27.28, 26.39, + & 25.52, + & 24.69, 23.89, 23.12, 22.37, 21.65, 20.94, 20.26, 19.60, 18.96, + & 18.33, + & 17.72, 17.12, 16.53, 15.96, 15.40, 14.85, 14.31, 13.78, 13.26, + & 12.75, + & 12.25, 11.75, 11.26, 10.77, 10.29, 9.82, 9.35, 8.88, 8.42, + & 7.97, + & 7.52, 7.07, 6.62, 6.18, 5.75, 5.32, 4.89, 4.47, 4.05, + & 3.64, + & 3.24, 2.84, 2.45, 2.07, 1.70, 1.34, 0.99, 0.65, 0.31, + & 0.1/ +C +C awsc= sodium chloride +C + DATA AWSC/10*28.16, + & 27.17, 26.27, 25.45, 24.69, 23.98, 23.33, 22.72, 22.14, 21.59, + & 21.08, + & 20.58, 20.12, 19.67, 19.24, 18.82, 18.43, 18.04, 17.67, 17.32, + & 16.97, + & 16.63, 16.31, 15.99, 15.68, 15.38, 15.08, 14.79, 14.51, 14.24, + & 13.97, + & 13.70, 13.44, 13.18, 12.93, 12.68, 12.44, 12.20, 11.96, 11.73, + & 11.50, + & 11.27, 11.05, 10.82, 10.60, 10.38, 10.16, 9.95, 9.74, 9.52, + & 9.31, + & 9.10, 8.89, 8.69, 8.48, 8.27, 8.07, 7.86, 7.65, 7.45, + & 7.24, + & 7.04, 6.83, 6.62, 6.42, 6.21, 6.00, 5.79, 5.58, 5.36, + & 5.15, + & 4.93, 4.71, 4.48, 4.26, 4.03, 3.80, 3.56, 3.32, 3.07, + & 2.82, + & 2.57, 2.30, 2.04, 1.76, 1.48, 1.20, 0.91, 0.61, 0.30, + & 0.1/ +C +C awac= ammonium chloride +C + DATA AWAC/10*1209.00, + & 1067.60,949.27,848.62,761.82,686.04,619.16,559.55,505.92,457.25, + & 412.69, + & 371.55,333.21,297.13,262.81,229.78,197.59,165.98,135.49,108.57, + & 88.29, + & 74.40, 64.75, 57.69, 52.25, 47.90, 44.30, 41.27, 38.65, 36.36, + & 34.34, + & 32.52, 30.88, 29.39, 28.02, 26.76, 25.60, 24.51, 23.50, 22.55, + & 21.65, + & 20.80, 20.00, 19.24, 18.52, 17.83, 17.17, 16.54, 15.93, 15.35, + & 14.79, + & 14.25, 13.73, 13.22, 12.73, 12.26, 11.80, 11.35, 10.92, 10.49, + & 10.08, + & 9.67, 9.28, 8.89, 8.51, 8.14, 7.77, 7.42, 7.06, 6.72, + & 6.37, + & 6.03, 5.70, 5.37, 5.05, 4.72, 4.40, 4.08, 3.77, 3.45, + & 3.14, + & 2.82, 2.51, 2.20, 1.89, 1.57, 1.26, 0.94, 0.62, 0.31, + & 0.1/ +C +C awss= sodium sulfate +C + DATA AWSS/10*24.10, + & 23.17, 22.34, 21.58, 20.90, 20.27, 19.69, 19.15, 18.64, 18.17, + & 17.72, + & 17.30, 16.90, 16.52, 16.16, 15.81, 15.48, 15.16, 14.85, 14.55, + & 14.27, + & 13.99, 13.73, 13.47, 13.21, 12.97, 12.73, 12.50, 12.27, 12.05, + & 11.84, + & 11.62, 11.42, 11.21, 11.01, 10.82, 10.63, 10.44, 10.25, 10.07, + & 9.89, + & 9.71, 9.53, 9.36, 9.19, 9.02, 8.85, 8.68, 8.51, 8.35, + & 8.19, + & 8.02, 7.86, 7.70, 7.54, 7.38, 7.22, 7.06, 6.90, 6.74, + & 6.58, + & 6.42, 6.26, 6.10, 5.94, 5.78, 5.61, 5.45, 5.28, 5.11, + & 4.93, + & 4.76, 4.58, 4.39, 4.20, 4.01, 3.81, 3.60, 3.39, 3.16, + & 2.93, + & 2.68, 2.41, 2.13, 1.83, 1.52, 1.19, 0.86, 0.54, 0.25, + & 0.1/ +C +C awab= ammonium bisulfate +C + DATA AWAB/10*312.84, + & 271.43,237.19,208.52,184.28,163.64,145.97,130.79,117.72,106.42, + & 96.64, + & 88.16, 80.77, 74.33, 68.67, 63.70, 59.30, 55.39, 51.89, 48.76, + & 45.93, + & 43.38, 41.05, 38.92, 36.97, 35.18, 33.52, 31.98, 30.55, 29.22, + & 27.98, + & 26.81, 25.71, 24.67, 23.70, 22.77, 21.90, 21.06, 20.27, 19.52, + & 18.80, + & 18.11, 17.45, 16.82, 16.21, 15.63, 15.07, 14.53, 14.01, 13.51, + & 13.02, + & 12.56, 12.10, 11.66, 11.24, 10.82, 10.42, 10.04, 9.66, 9.29, + & 8.93, + & 8.58, 8.24, 7.91, 7.58, 7.26, 6.95, 6.65, 6.35, 6.05, + & 5.76, + & 5.48, 5.20, 4.92, 4.64, 4.37, 4.09, 3.82, 3.54, 3.27, + & 2.99, + & 2.70, 2.42, 2.12, 1.83, 1.52, 1.22, 0.90, 0.59, 0.28, + & 0.1/ +C +C awsa= sulfuric acid +C + DATA AWSA/34.00, 33.56, 29.22, 26.55, 24.61, 23.11, 21.89, 20.87, + & 19.99, 18.45, + & 17.83, 17.26, 16.73, 16.25, 15.80, 15.38, 14.98, 14.61, 14.26, + & 13.93, + & 13.61, 13.30, 13.01, 12.73, 12.47, 12.21, 11.96, 11.72, 11.49, + & 11.26, + & 11.04, 10.83, 10.62, 10.42, 10.23, 10.03, 9.85, 9.67, 9.49, + & 9.31, + & 9.14, 8.97, 8.81, 8.65, 8.49, 8.33, 8.18, 8.02, 7.87, + & 7.73, + & 7.58, 7.44, 7.29, 7.15, 7.01, 6.88, 6.74, 6.61, 6.47, + & 6.34, + & 6.21, 6.07, 5.94, 5.81, 5.68, 5.55, 5.43, 5.30, 5.17, + & 5.04, + & 4.91, 4.78, 4.65, 4.52, 4.39, 4.26, 4.13, 4.00, 3.86, + & 3.73, + & 3.59, 3.45, 3.31, 3.17, 3.02, 2.87, 2.71, 2.56, 2.39, + & 2.22, + & 2.05, 1.87, 1.68, 1.48, 1.27, 1.04, 0.80, 0.55, 0.28, + & 0.1/ +C +C awlc= (NH4)3H(SO4)2 +C + DATA AWLC/10*125.37, + & 110.10, 97.50, 86.98, 78.08, 70.49, 63.97, 58.33, 53.43, 49.14, + & 45.36, + & 42.03, 39.07, 36.44, 34.08, 31.97, 30.06, 28.33, 26.76, 25.32, + & 24.01, + & 22.81, 21.70, 20.67, 19.71, 18.83, 18.00, 17.23, 16.50, 15.82, + & 15.18, + & 14.58, 14.01, 13.46, 12.95, 12.46, 11.99, 11.55, 11.13, 10.72, + & 10.33, + & 9.96, 9.60, 9.26, 8.93, 8.61, 8.30, 8.00, 7.72, 7.44, + & 7.17, + & 6.91, 6.66, 6.42, 6.19, 5.96, 5.74, 5.52, 5.31, 5.11, + & 4.91, + & 4.71, 4.53, 4.34, 4.16, 3.99, 3.81, 3.64, 3.48, 3.31, + & 3.15, + & 2.99, 2.84, 2.68, 2.53, 2.37, 2.22, 2.06, 1.91, 1.75, + & 1.60, + & 1.44, 1.28, 1.12, 0.95, 0.79, 0.62, 0.45, 0.29, 0.14, + & 0.1/ +C +C awan= ammonium nitrate +C + DATA AWAN/10*960.19, + & 853.15,763.85,688.20,623.27,566.92,517.54,473.91,435.06,400.26, + & 368.89, + & 340.48,314.63,291.01,269.36,249.46,231.11,214.17,198.50,184.00, + & 170.58, + & 158.15,146.66,136.04,126.25,117.24,108.97,101.39, 94.45, 88.11, + & 82.33, + & 77.06, 72.25, 67.85, 63.84, 60.16, 56.78, 53.68, 50.81, 48.17, + & 45.71, + & 43.43, 41.31, 39.32, 37.46, 35.71, 34.06, 32.50, 31.03, 29.63, + & 28.30, + & 27.03, 25.82, 24.67, 23.56, 22.49, 21.47, 20.48, 19.53, 18.61, + & 17.72, + & 16.86, 16.02, 15.20, 14.41, 13.64, 12.89, 12.15, 11.43, 10.73, + & 10.05, + & 9.38, 8.73, 8.09, 7.47, 6.86, 6.27, 5.70, 5.15, 4.61, + & 4.09, + & 3.60, 3.12, 2.66, 2.23, 1.81, 1.41, 1.03, 0.67, 0.32, + & 0.1/ +C +C awsb= sodium bisulfate +C + DATA AWSB/10*55.99, + & 53.79, 51.81, 49.99, 48.31, 46.75, 45.28, 43.91, 42.62, 41.39, + & 40.22, + & 39.10, 38.02, 36.99, 36.00, 35.04, 34.11, 33.21, 32.34, 31.49, + & 30.65, + & 29.84, 29.04, 28.27, 27.50, 26.75, 26.01, 25.29, 24.57, 23.87, + & 23.17, + & 22.49, 21.81, 21.15, 20.49, 19.84, 19.21, 18.58, 17.97, 17.37, + & 16.77, + & 16.19, 15.63, 15.08, 14.54, 14.01, 13.51, 13.01, 12.53, 12.07, + & 11.62, + & 11.19, 10.77, 10.36, 9.97, 9.59, 9.23, 8.87, 8.53, 8.20, + & 7.88, + & 7.57, 7.27, 6.97, 6.69, 6.41, 6.14, 5.88, 5.62, 5.36, + & 5.11, + & 4.87, 4.63, 4.39, 4.15, 3.92, 3.68, 3.45, 3.21, 2.98, + & 2.74, + & 2.49, 2.24, 1.98, 1.72, 1.44, 1.16, 0.87, 0.57, 0.28, + & 0.1/ +C +C *** ZSR RELATIONSHIP PARAMETERS ************************************** +c +C awas= ammonium sulfate +C +C DATA AWAS/33*100.,30,30,30,29.54,28.25,27.06,25.94, +C & 24.89,23.90,22.97,22.10,21.27,20.48,19.73,19.02,18.34,17.69, +C & 17.07,16.48,15.91,15.37,14.85,14.34,13.86,13.39,12.94,12.50, +C & 12.08,11.67,11.27,10.88,10.51,10.14, 9.79, 9.44, 9.10, 8.78, +C & 8.45, 8.14, 7.83, 7.53, 7.23, 6.94, 6.65, 6.36, 6.08, 5.81, +C & 5.53, 5.26, 4.99, 4.72, 4.46, 4.19, 3.92, 3.65, 3.38, 3.11, +C & 2.83, 2.54, 2.25, 1.95, 1.63, 1.31, 0.97, 0.63, 0.30, 0.001/ +C +C awsn= sodium nitrate +C +C DATA AWSN/ 9*1.e5,685.59, +C & 451.00,336.46,268.48,223.41,191.28, +C & 167.20,148.46,133.44,121.12,110.83, +C & 102.09,94.57,88.03,82.29,77.20,72.65,68.56,64.87,61.51,58.44, +C & 55.62,53.03,50.63,48.40,46.32,44.39,42.57,40.87,39.27,37.76, +C & 36.33,34.98,33.70,32.48,31.32,30.21,29.16,28.14,27.18,26.25, +C & 25.35,24.50,23.67,22.87,22.11,21.36,20.65,19.95,19.28,18.62, +C & 17.99,17.37,16.77,16.18,15.61,15.05,14.51,13.98,13.45,12.94, +C & 12.44,11.94,11.46,10.98,10.51,10.04, 9.58, 9.12, 8.67, 8.22, +C & 7.77, 7.32, 6.88, 6.43, 5.98, 5.53, 5.07, 4.61, 4.15, 3.69, +C & 3.22, 2.76, 2.31, 1.87, 1.47, 1.10, 0.77, 0.48, 0.23, 0.001/ +C +C awsc= sodium chloride +C +C DATA AWSC/ +C & 100., 100., 100., 100., 100., 100., 100., 100., 100., 100., +C & 100., 100., 100., 100., 100., 100., 100., 100., 100.,16.34, +C & 16.28,16.22,16.15,16.09,16.02,15.95,15.88,15.80,15.72,15.64, +C & 15.55,15.45,15.36,15.25,15.14,15.02,14.89,14.75,14.60,14.43, +C & 14.25,14.04,13.81,13.55,13.25,12.92,12.56,12.19,11.82,11.47, +C & 11.13,10.82,10.53,10.26,10.00, 9.76, 9.53, 9.30, 9.09, 8.88, +C & 8.67, 8.48, 8.28, 8.09, 7.90, 7.72, 7.54, 7.36, 7.17, 6.99, +C & 6.81, 6.63, 6.45, 6.27, 6.09, 5.91, 5.72, 5.53, 5.34, 5.14, +C & 4.94, 4.74, 4.53, 4.31, 4.09, 3.86, 3.62, 3.37, 3.12, 2.85, +C & 2.58, 2.30, 2.01, 1.72, 1.44, 1.16, 0.89, 0.64, 0.40, 0.18/ +C +C awac= ammonium chloride +C +C DATA AWAC/ +C & 100., 100., 100., 100., 100., 100., 100., 100., 100., 100., +C & 100., 100., 100., 100., 100., 100., 100., 100., 100.,31.45, +C & 31.30,31.14,30.98,30.82,30.65,30.48,30.30,30.11,29.92,29.71, +C & 29.50,29.29,29.06,28.82,28.57,28.30,28.03,27.78,27.78,27.77, +C & 27.77,27.43,27.07,26.67,26.21,25.73,25.18,24.56,23.84,23.01, +C & 22.05,20.97,19.85,18.77,17.78,16.89,16.10,15.39,14.74,14.14, +C & 13.59,13.06,12.56,12.09,11.65,11.22,10.81,10.42,10.03, 9.66, +C & 9.30, 8.94, 8.59, 8.25, 7.92, 7.59, 7.27, 6.95, 6.63, 6.32, +C & 6.01, 5.70, 5.39, 5.08, 4.78, 4.47, 4.17, 3.86, 3.56, 3.25, +C & 2.94, 2.62, 2.30, 1.98, 1.65, 1.32, 0.97, 0.62, 0.26, 0.13/ +C +C awss= sodium sulfate +C +C DATA AWSS/34*1.e5,23*14.30,14.21,12.53,11.47, +C & 10.66,10.01, 9.46, 8.99, 8.57, 8.19, 7.85, 7.54, 7.25, 6.98, +C & 6.74, 6.50, 6.29, 6.08, 5.88, 5.70, 5.52, 5.36, 5.20, 5.04, +C & 4.90, 4.75, 4.54, 4.34, 4.14, 3.93, 3.71, 3.49, 3.26, 3.02, +C & 2.76, 2.49, 2.20, 1.89, 1.55, 1.18, 0.82, 0.49, 0.22, 0.001/ +C +C awab= ammonium bisulfate +C +C DATA AWAB/356.45,296.51,253.21,220.47,194.85, +C & 174.24,157.31,143.16,131.15,120.82, +C & 111.86,103.99,97.04,90.86,85.31,80.31,75.78,71.66,67.90,64.44, +C & 61.25,58.31,55.58,53.04,50.68,48.47,46.40,44.46,42.63,40.91, +C & 39.29,37.75,36.30,34.92,33.61,32.36,31.18,30.04,28.96,27.93, +C & 26.94,25.99,25.08,24.21,23.37,22.57,21.79,21.05,20.32,19.63, +C & 18.96,18.31,17.68,17.07,16.49,15.92,15.36,14.83,14.31,13.80, +C & 13.31,12.83,12.36,11.91,11.46,11.03,10.61,10.20, 9.80, 9.41, +C & 9.02, 8.64, 8.28, 7.91, 7.56, 7.21, 6.87, 6.54, 6.21, 5.88, +C & 5.56, 5.25, 4.94, 4.63, 4.33, 4.03, 3.73, 3.44, 3.14, 2.85, +C & 2.57, 2.28, 1.99, 1.71, 1.42, 1.14, 0.86, 0.57, 0.29, 0.001/ +C +C awsa= sulfuric acid +C +C DATA AWSA/ +C & 34.0,33.56,29.22,26.55,24.61,23.11,21.89,20.87,19.99, +C & 19.21,18.51,17.87,17.29,16.76,16.26,15.8,15.37,14.95,14.56, +C & 14.20,13.85,13.53,13.22,12.93,12.66,12.40,12.14,11.90,11.67, +C & 11.44,11.22,11.01,10.8,10.60,10.4,10.2,10.01,9.83,9.65,9.47, +C & 9.3,9.13,8.96,8.81,8.64,8.48,8.33,8.17,8.02,7.87,7.72,7.58, +C & 7.44,7.30,7.16,7.02,6.88,6.75,6.61,6.48,6.35,6.21,6.08,5.95, +C & 5.82,5.69,5.56,5.44,5.31,5.18,5.05,4.92,4.79,4.66,4.53,4.40, +C & 4.27,4.14,4.,3.87,3.73,3.6,3.46,3.31,3.17,3.02,2.87,2.72, +C & 2.56,2.4,2.23,2.05,1.87,1.68,1.48,1.27,1.05,0.807,0.552,0.281/ +C +C awlc= (NH4)3H(SO4)2 +C +C DATA AWLC/34*1.e5,17.0,16.5,15.94,15.31,14.71,14.14, +C & 13.60,13.08,12.59,12.12,11.68,11.25,10.84,10.44,10.07, 9.71, +C & 9.36, 9.02, 8.70, 8.39, 8.09, 7.80, 7.52, 7.25, 6.99, 6.73, +C & 6.49, 6.25, 6.02, 5.79, 5.57, 5.36, 5.15, 4.95, 4.76, 4.56, +C & 4.38, 4.20, 4.02, 3.84, 3.67, 3.51, 3.34, 3.18, 3.02, 2.87, +C & 2.72, 2.57, 2.42, 2.28, 2.13, 1.99, 1.85, 1.71, 1.57, 1.43, +C & 1.30, 1.16, 1.02, 0.89, 0.75, 0.61, 0.46, 0.32, 0.16, 0.001/ +C +C awan= ammonium nitrate +C +C DATA AWAN/31*1.e5, +C & 97.17,92.28,87.66,83.15,78.87,74.84,70.98,67.46,64.11, +C & 60.98,58.07,55.37,52.85,50.43,48.24,46.19,44.26,42.40,40.70, +C & 39.10,37.54,36.10,34.69,33.35,32.11,30.89,29.71,28.58,27.46, +C & 26.42,25.37,24.33,23.89,22.42,21.48,20.56,19.65,18.76,17.91, +C & 17.05,16.23,15.40,14.61,13.82,13.03,12.30,11.55,10.83,10.14, +C & 9.44, 8.79, 8.13, 7.51, 6.91, 6.32, 5.75, 5.18, 4.65, 4.14, +C & 3.65, 3.16, 2.71, 2.26, 1.83, 1.42, 1.03, 0.66, 0.30, 0.001/ +C +C awsb= sodium bisulfate +C +C DATA AWSB/173.72,156.88,142.80,130.85,120.57, +C & 111.64,103.80,96.88,90.71,85.18, +C & 80.20,75.69,71.58,67.82,64.37,61.19,58.26,55.53,53.00,50.64, +C & 48.44,46.37,44.44,42.61,40.90,39.27,37.74,36.29,34.91,33.61, +C & 32.36,31.18,30.05,28.97,27.94,26.95,26.00,25.10,24.23,23.39, +C & 22.59,21.81,21.07,20.35,19.65,18.98,18.34,17.71,17.11,16.52, +C & 15.95,15.40,14.87,14.35,13.85,13.36,12.88,12.42,11.97,11.53, +C & 11.10,10.69,10.28, 9.88, 9.49, 9.12, 8.75, 8.38, 8.03, 7.68, +C & 7.34, 7.01, 6.69, 6.37, 6.06, 5.75, 5.45, 5.15, 4.86, 4.58, +C & 4.30, 4.02, 3.76, 3.49, 3.23, 2.98, 2.73, 2.48, 2.24, 2.01, +C & 1.78, 1.56, 1.34, 1.13, 0.92, 0.73, 0.53, 0.35, 0.17, 0.001/ +C +C *** END OF BLOCK DATA SUBPROGRAM ************************************* +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE INIT1 +C *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM +C SULFATE AEROSOL SYSTEMS (SUBROUTINE ISRP1) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE INIT1 (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) + REAL IC,GII,GI0,XX,LN10 + PARAMETER (LN10=2.3025851) +C +C *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** +C + IF (IPROB.EQ.0) THEN ! FORWARD CALCULATION + DO 10 I=1,NCOMP + W(I) = MAX(WI(I), TINY) +10 CONTINUE + ELSE + DO 15 I=1,NCOMP ! REVERSE CALCULATION + WAER(I) = MAX(WI(I), TINY) + W(I) = ZERO +15 CONTINUE + ENDIF + RH = RHI + TEMP = TEMPI +C +C *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** +C + XK1 = 1.015e-2 ! HSO4(aq) <==> H(aq) + SO4(aq) + XK21 = 57.639 ! NH3(g) <==> NH3(aq) + XK22 = 1.805e-5 ! NH3(aq) <==> NH4(aq) + OH(aq) + XK7 = 1.817 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) + XK12 = 1.382e2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) + XK13 = 29.268 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) + XKW = 1.010e-14 ! H2O <==> H(aq) + OH(aq) +C + IF (INT(TEMP) .NE. 298) THEN ! FOR T != 298K or 298.15K + T0 = 298.15 + T0T = T0/TEMP + COEF= 1.0+LOG(T0T)-T0T + XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) + XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) + XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) + XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) + XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) + XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) + XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) + ENDIF + XK2 = XK21*XK22 +C +C *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** +C + DRH2SO4 = 0.0000D0 + DRNH42S4 = 0.7997D0 + DRNH4HS4 = 0.4000D0 + DRLC = 0.6900D0 + IF (INT(TEMP) .NE. 298) THEN + T0 = 298.15d0 + TCF = 1.0/TEMP - 1.0/T0 + DRNH42S4 = DRNH42S4*EXP( 80.*TCF) + DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) + DRLC = DRLC *EXP(186.*TCF) + ENDIF +C +C *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** +C + DRMLCAB = 0.3780D0 ! (NH4)3H(SO4)2 & NH4HSO4 + DRMLCAS = 0.6900D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 +CCC IF (INT(TEMP) .NE. 298) THEN ! For the time being. +CCC T0 = 298.15d0 +CCC TCF = 1.0/TEMP - 1.0/T0 +CCC DRMLCAB = DRMLCAB*EXP(507.506*TCF) +CCC DRMLCAS = DRMLCAS*EXP(133.865*TCF) +CCC ENDIF +C +C *** LIQUID PHASE ****************************************************** +C + CHNO3 = ZERO + CHCL = ZERO + CH2SO4 = ZERO + COH = ZERO + WATER = TINY +C + DO 20 I=1,NPAIR + MOLALR(I)=ZERO + GAMA(I) =0.1 + GAMIN(I) =GREAT + GAMOU(I) =GREAT + M0(I) =1d5 + 20 CONTINUE +C + DO 30 I=1,NPAIR + GAMA(I) = 0.1d0 + 30 CONTINUE +C + DO 40 I=1,NIONS + MOLAL(I)=ZERO +40 CONTINUE + COH = ZERO +C + DO 50 I=1,NGASAQ + GASAQ(I)=ZERO +50 CONTINUE +C +C *** SOLID PHASE ******************************************************* +C + CNH42S4= ZERO + CNH4HS4= ZERO + CNACL = ZERO + CNA2SO4= ZERO + CNANO3 = ZERO + CNH4NO3= ZERO + CNH4CL = ZERO + CNAHSO4= ZERO + CLC = ZERO +C +C *** GAS PHASE ********************************************************* +C + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO +C +C *** CALCULATE ZSR PARAMETERS ****************************************** +C + IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays + IRH = MAX (IRH, 1) +C + M0(01) = AWSC(IRH) ! NACl + IF (M0(01) .LT. 100.0) THEN + IC = M0(01) + CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(01) = M0(01)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(02) = AWSS(IRH) ! (NA)2SO4 + IF (M0(02) .LT. 100.0) THEN + IC = 3.0*M0(02) + CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(02) = M0(02)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(03) = AWSN(IRH) ! NANO3 + IF (M0(03) .LT. 100.0) THEN + IC = M0(03) + CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(03) = M0(03)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(04) = AWAS(IRH) ! (NH4)2SO4 + IF (M0(04) .LT. 100.0) THEN + IC = 3.0*M0(04) + CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX) + M0(04) = M0(04)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(05) = AWAN(IRH) ! NH4NO3 + IF (M0(05) .LT. 100.0) THEN + IC = M0(05) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX) + M0(05) = M0(05)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(06) = AWAC(IRH) ! NH4CL + IF (M0(06) .LT. 100.0) THEN + IC = M0(06) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX) + M0(06) = M0(06)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(07) = AWSA(IRH) ! 2H-SO4 + IF (M0(07) .LT. 100.0) THEN + IC = 3.0*M0(07) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX) + M0(07) = M0(07)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(08) = AWSA(IRH) ! H-HSO4 +CCC IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used +CCC IC = M0(08) +CCC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) +CCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) +CCCCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) +CCC M0(08) = M0(08)*EXP(LN10*(GI0-GII)) +CCC ENDIF +C + M0(09) = AWAB(IRH) ! NH4HSO4 + IF (M0(09) .LT. 100.0) THEN + IC = M0(09) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX) + M0(09) = M0(09)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(12) = AWSB(IRH) ! NAHSO4 + IF (M0(12) .LT. 100.0) THEN + IC = M0(12) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII) + M0(12) = M0(12)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 + IF (M0(13) .LT. 100.0) THEN + IC = 4.0*M0(13) + CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX) + G130 = 0.2*(3.0*GI0+2.0*GII) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX) + G13I = 0.2*(3.0*GI0+2.0*GII) + M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) + ENDIF +C +C *** OTHER INITIALIZATIONS ********************************************* +C + ICLACT = 0 + CALAOU = .TRUE. + CALAIN = .TRUE. + FRST = .TRUE. + SCASE = '??' + SULRATW = 2.D0 + SODRAT = ZERO + NOFER = 0 + STKOFL =.FALSE. + DO 60 I=1,NERRMX + ERRSTK(I) =-999 + ERRMSG(I) = 'MESSAGE N/A' + 60 CONTINUE +C +C *** END OF SUBROUTINE INIT1 ******************************************* +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE INIT2 +C *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM, +C NITRATE, SULFATE AEROSOL SYSTEMS (SUBROUTINE ISRP2) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE INIT2 (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) + REAL IC,GII,GI0,XX,LN10 + PARAMETER (LN10=2.3025851) +C +C *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** +C + IF (IPROB.EQ.0) THEN ! FORWARD CALCULATION + DO 10 I=1,NCOMP + W(I) = MAX(WI(I), TINY) +10 CONTINUE + ELSE + DO 15 I=1,NCOMP ! REVERSE CALCULATION + WAER(I) = MAX(WI(I), TINY) + W(I) = ZERO +15 CONTINUE + ENDIF + RH = RHI + TEMP = TEMPI +C +C *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** +C + XK1 = 1.015e-2 ! HSO4(aq) <==> H(aq) + SO4(aq) + XK21 = 57.639 ! NH3(g) <==> NH3(aq) + XK22 = 1.805e-5 ! NH3(aq) <==> NH4(aq) + OH(aq) + XK4 = 2.511e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! ISORR +CCC XK4 = 3.638e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! SEQUIL + XK41 = 2.100e5 ! HNO3(g) <==> HNO3(aq) + XK7 = 1.817 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) + XK10 = 5.746e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! ISORR +CCC XK10 = 2.985e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! SEQUIL + XK12 = 1.382e2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) + XK13 = 29.268 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) + XKW = 1.010e-14 ! H2O <==> H(aq) + OH(aq) +C + IF (INT(TEMP) .NE. 298) THEN ! FOR T != 298K or 298.15K + T0 = 298.15D0 + T0T = T0/TEMP + COEF= 1.0+LOG(T0T)-T0T + XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) + XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) + XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) + XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR +CCC XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL + XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF) + XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) + XK10= XK10*EXP(-74.38*(T0T-1.0) + 6.120*COEF) ! ISORR +CCC XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL + XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) + XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) + XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) + ENDIF + XK2 = XK21*XK22 + XK42 = XK4/XK41 +C +C *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** +C + DRH2SO4 = ZERO + DRNH42S4 = 0.7997D0 + DRNH4HS4 = 0.4000D0 + DRNH4NO3 = 0.6183D0 + DRLC = 0.6900D0 + IF (INT(TEMP) .NE. 298) THEN + T0 = 298.15D0 + TCF = 1.0/TEMP - 1.0/T0 + DRNH4NO3 = DRNH4NO3*EXP(852.*TCF) + DRNH42S4 = DRNH42S4*EXP( 80.*TCF) + DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) + DRLC = DRLC *EXP(186.*TCF) + DRNH4NO3 = MIN (DRNH4NO3,DRNH42S4) ! ADJUST FOR DRH CROSSOVER AT T<271K + ENDIF +C +C *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** +C + DRMLCAB = 0.3780D0 ! (NH4)3H(SO4)2 & NH4HSO4 + DRMLCAS = 0.6900D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 + DRMASAN = 0.6000D0 ! (NH4)2SO4 & NH4NO3 +CCC IF (INT(TEMP) .NE. 298) THEN ! For the time being +CCC T0 = 298.15d0 +CCC TCF = 1.0/TEMP - 1.0/T0 +CCC DRMLCAB = DRMLCAB*EXP( 507.506*TCF) +CCC DRMLCAS = DRMLCAS*EXP( 133.865*TCF) +CCC DRMASAN = DRMASAN*EXP(1269.068*TCF) +CCC ENDIF +C +C *** LIQUID PHASE ****************************************************** +C + CHNO3 = ZERO + CHCL = ZERO + CH2SO4 = ZERO + COH = ZERO + WATER = TINY +C + DO 20 I=1,NPAIR + MOLALR(I)=ZERO + GAMA(I) =0.1 + GAMIN(I) =GREAT + GAMOU(I) =GREAT + M0(I) =1d5 + 20 CONTINUE +C + DO 30 I=1,NPAIR + GAMA(I) = 0.1d0 + 30 CONTINUE +C + DO 40 I=1,NIONS + MOLAL(I)=ZERO +40 CONTINUE + COH = ZERO +C + DO 50 I=1,NGASAQ + GASAQ(I)=ZERO +50 CONTINUE +C +C *** SOLID PHASE ******************************************************* +C + CNH42S4= ZERO + CNH4HS4= ZERO + CNACL = ZERO + CNA2SO4= ZERO + CNANO3 = ZERO + CNH4NO3= ZERO + CNH4CL = ZERO + CNAHSO4= ZERO + CLC = ZERO +C +C *** GAS PHASE ********************************************************* +C + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO +C +C *** CALCULATE ZSR PARAMETERS ****************************************** +C + IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays + IRH = MAX (IRH, 1) +C + M0(01) = AWSC(IRH) ! NACl + IF (M0(01) .LT. 100.0) THEN + IC = M0(01) + CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(01) = M0(01)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(02) = AWSS(IRH) ! (NA)2SO4 + IF (M0(02) .LT. 100.0) THEN + IC = 3.0*M0(02) + CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(02) = M0(02)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(03) = AWSN(IRH) ! NANO3 + IF (M0(03) .LT. 100.0) THEN + IC = M0(03) + CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(03) = M0(03)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(04) = AWAS(IRH) ! (NH4)2SO4 + IF (M0(04) .LT. 100.0) THEN + IC = 3.0*M0(04) + CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX) + M0(04) = M0(04)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(05) = AWAN(IRH) ! NH4NO3 + IF (M0(05) .LT. 100.0) THEN + IC = M0(05) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX) + M0(05) = M0(05)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(06) = AWAC(IRH) ! NH4CL + IF (M0(06) .LT. 100.0) THEN + IC = M0(06) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX) + M0(06) = M0(06)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(07) = AWSA(IRH) ! 2H-SO4 + IF (M0(07) .LT. 100.0) THEN + IC = 3.0*M0(07) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX) + M0(07) = M0(07)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(08) = AWSA(IRH) ! H-HSO4 +CCC IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used +CCC IC = M0(08) +CCC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) +CCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) +CCCCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) +CCC M0(08) = M0(08)*EXP(LN10*(GI0-GII)) +CCC ENDIF +C + M0(09) = AWAB(IRH) ! NH4HSO4 + IF (M0(09) .LT. 100.0) THEN + IC = M0(09) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX) + M0(09) = M0(09)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(12) = AWSB(IRH) ! NAHSO4 + IF (M0(12) .LT. 100.0) THEN + IC = M0(12) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII) + M0(12) = M0(12)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 + IF (M0(13) .LT. 100.0) THEN + IC = 4.0*M0(13) + CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX) + G130 = 0.2*(3.0*GI0+2.0*GII) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX) + G13I = 0.2*(3.0*GI0+2.0*GII) + M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) + ENDIF +C +C *** OTHER INITIALIZATIONS ********************************************* +C + ICLACT = 0 + CALAOU = .TRUE. + CALAIN = .TRUE. + FRST = .TRUE. + SCASE = '??' + SULRATW = 2.D0 + SODRAT = ZERO + NOFER = 0 + STKOFL =.FALSE. + DO 60 I=1,NERRMX + ERRSTK(I) =-999 + ERRMSG(I) = 'MESSAGE N/A' + 60 CONTINUE +C +C *** END OF SUBROUTINE INIT2 ******************************************* +C + END + + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISOINIT3 +C *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM, +C SODIUM, CHLORIDE, NITRATE, SULFATE AEROSOL SYSTEMS (SUBROUTINE +C ISRP3) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISOINIT3 (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) + REAL IC,GII,GI0,XX,LN10 + PARAMETER (LN10=2.3025851) +C +C *** SAVE INPUT VARIABLES IN COMMON BLOCK ****************************** +C + IF (IPROB.EQ.0) THEN ! FORWARD CALCULATION + DO 10 I=1,NCOMP + W(I) = MAX(WI(I), TINY) +10 CONTINUE + ELSE + DO 15 I=1,NCOMP ! REVERSE CALCULATION + WAER(I) = MAX(WI(I), TINY) + W(I) = ZERO +15 CONTINUE + ENDIF + RH = RHI + TEMP = TEMPI +C +C *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** +C + XK1 = 1.015D-2 ! HSO4(aq) <==> H(aq) + SO4(aq) + XK21 = 57.639D0 ! NH3(g) <==> NH3(aq) + XK22 = 1.805D-5 ! NH3(aq) <==> NH4(aq) + OH(aq) + XK3 = 1.971D6 ! HCL(g) <==> H(aq) + CL(aq) + XK31 = 2.500e3 ! HCL(g) <==> HCL(aq) + XK4 = 2.511e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! ISORR +CCC XK4 = 3.638e6 ! HNO3(g) <==> H(aq) + NO3(aq) ! SEQUIL + XK41 = 2.100e5 ! HNO3(g) <==> HNO3(aq) + XK5 = 0.4799D0 ! NA2SO4(s) <==> 2*NA(aq) + SO4(aq) + XK6 = 1.086D-16 ! NH4CL(s) <==> NH3(g) + HCL(g) + XK7 = 1.817D0 ! (NH4)2SO4(s) <==> 2*NH4(aq) + SO4(aq) + XK8 = 37.661D0 ! NACL(s) <==> NA(aq) + CL(aq) + XK10 = 5.746D-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! ISORR +CCC XK10 = 2.985e-17 ! NH4NO3(s) <==> NH3(g) + HNO3(g) ! SEQUIL + XK11 = 2.413D4 ! NAHSO4(s) <==> NA(aq) + HSO4(aq) + XK12 = 1.382D2 ! NH4HSO4(s) <==> NH4(aq) + HSO4(aq) + XK13 = 29.268D0 ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq) + XK14 = 22.05D0 ! NH4CL(s) <==> NH4(aq) + CL(aq) + XKW = 1.010D-14 ! H2O <==> H(aq) + OH(aq) + XK9 = 11.977D0 ! NANO3(s) <==> NA(aq) + NO3(aq) +C + IF (INT(TEMP) .NE. 298) THEN ! FOR T != 298K or 298.15K + T0 = 298.15D0 + T0T = T0/TEMP + COEF= 1.0+LOG(T0T)-T0T + XK1 = XK1 *EXP( 8.85*(T0T-1.0) + 25.140*COEF) + XK21= XK21*EXP( 13.79*(T0T-1.0) - 5.393*COEF) + XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF) + XK3 = XK3 *EXP( 30.20*(T0T-1.0) + 19.910*COEF) + XK31= XK31*EXP( 30.20*(T0T-1.0) + 19.910*COEF) + XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR +CCC XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL + XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF) + XK5 = XK5 *EXP( 0.98*(T0T-1.0) + 39.500*COEF) + XK6 = XK6 *EXP(-71.00*(T0T-1.0) + 2.400*COEF) + XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF) + XK8 = XK8 *EXP( -1.56*(T0T-1.0) + 16.900*COEF) + XK9 = XK9 *EXP( -8.22*(T0T-1.0) + 16.010*COEF) + XK10= XK10*EXP(-74.38*(T0T-1.0) + 6.120*COEF) ! ISORR +CCC XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL + XK11= XK11*EXP( 0.79*(T0T-1.0) + 14.746*COEF) + XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF) + XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF) + XK14= XK14*EXP( 24.55*(T0T-1.0) + 16.900*COEF) + XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF) + ENDIF + XK2 = XK21*XK22 + XK42 = XK4/XK41 + XK32 = XK3/XK31 +C +C *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ******** +C + DRH2SO4 = ZERO + DRNH42S4 = 0.7997D0 + DRNH4HS4 = 0.4000D0 + DRLC = 0.6900D0 + DRNACL = 0.7528D0 + DRNANO3 = 0.7379D0 + DRNH4CL = 0.7710D0 + DRNH4NO3 = 0.6183D0 + DRNA2SO4 = 0.9300D0 + DRNAHSO4 = 0.5200D0 + IF (INT(TEMP) .NE. 298) THEN + T0 = 298.15D0 + TCF = 1.0/TEMP - 1.0/T0 + DRNACL = DRNACL *EXP( 25.*TCF) + DRNANO3 = DRNANO3 *EXP(304.*TCF) + DRNA2SO4 = DRNA2SO4*EXP( 80.*TCF) + DRNH4NO3 = DRNH4NO3*EXP(852.*TCF) + DRNH42S4 = DRNH42S4*EXP( 80.*TCF) + DRNH4HS4 = DRNH4HS4*EXP(384.*TCF) + DRLC = DRLC *EXP(186.*TCF) + DRNH4CL = DRNH4Cl *EXP(239.*TCF) + DRNAHSO4 = DRNAHSO4*EXP(-45.*TCF) +C +C *** ADJUST FOR DRH "CROSSOVER" AT LOW TEMPERATURES +C + DRNH4NO3 = MIN (DRNH4NO3, DRNH4CL, DRNH42S4, DRNANO3, DRNACL) + DRNANO3 = MIN (DRNANO3, DRNACL) + DRNH4CL = MIN (DRNH4Cl, DRNH42S4) +C + ENDIF +C +C *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES **************** +C + DRMLCAB = 0.378D0 ! (NH4)3H(SO4)2 & NH4HSO4 + DRMLCAS = 0.690D0 ! (NH4)3H(SO4)2 & (NH4)2SO4 + DRMASAN = 0.600D0 ! (NH4)2SO4 & NH4NO3 + DRMG1 = 0.460D0 ! (NH4)2SO4, NH4NO3, NA2SO4, NH4CL + DRMG2 = 0.691D0 ! (NH4)2SO4, NA2SO4, NH4CL + DRMG3 = 0.697D0 ! (NH4)2SO4, NA2SO4 + DRMH1 = 0.240D0 ! NA2SO4, NANO3, NACL, NH4NO3, NH4CL + DRMH2 = 0.596D0 ! NA2SO4, NANO3, NACL, NH4CL + DRMI1 = 0.240D0 ! LC, NAHSO4, NH4HSO4, NA2SO4, (NH4)2SO4 + DRMI2 = 0.363D0 ! LC, NAHSO4, NA2SO4, (NH4)2SO4 - NO DATA - + DRMI3 = 0.610D0 ! LC, NA2SO4, (NH4)2SO4 + DRMQ1 = 0.494D0 ! (NH4)2SO4, NH4NO3, NA2SO4 + DRMR1 = 0.663D0 ! NA2SO4, NANO3, NACL + DRMR2 = 0.735D0 ! NA2SO4, NACL + DRMR3 = 0.673D0 ! NANO3, NACL + DRMR4 = 0.694D0 ! NA2SO4, NACL, NH4CL + DRMR5 = 0.731D0 ! NA2SO4, NH4CL + DRMR6 = 0.596D0 ! NA2SO4, NANO3, NH4CL + DRMR7 = 0.380D0 ! NA2SO4, NANO3, NACL, NH4NO3 + DRMR8 = 0.380D0 ! NA2SO4, NACL, NH4NO3 + DRMR9 = 0.494D0 ! NA2SO4, NH4NO3 + DRMR10 = 0.476D0 ! NA2SO4, NANO3, NH4NO3 + DRMR11 = 0.340D0 ! NA2SO4, NACL, NH4NO3, NH4CL + DRMR12 = 0.460D0 ! NA2SO4, NH4NO3, NH4CL + DRMR13 = 0.438D0 ! NA2SO4, NANO3, NH4NO3, NH4CL +CCC IF (INT(TEMP) .NE. 298) THEN +CCC T0 = 298.15d0 +CCC TCF = 1.0/TEMP - 1.0/T0 +CCC DRMLCAB = DRMLCAB*EXP( 507.506*TCF) +CCC DRMLCAS = DRMLCAS*EXP( 133.865*TCF) +CCC DRMASAN = DRMASAN*EXP(1269.068*TCF) +CCC DRMG1 = DRMG1 *EXP( 572.207*TCF) +CCC DRMG2 = DRMG2 *EXP( 58.166*TCF) +CCC DRMG3 = DRMG3 *EXP( 22.253*TCF) +CCC DRMH1 = DRMH1 *EXP(2116.542*TCF) +CCC DRMH2 = DRMH2 *EXP( 650.549*TCF) +CCC DRMI1 = DRMI1 *EXP( 565.743*TCF) +CCC DRMI2 = DRMI2 *EXP( 91.745*TCF) +CCC DRMI3 = DRMI3 *EXP( 161.272*TCF) +CCC DRMQ1 = DRMQ1 *EXP(1616.621*TCF) +CCC DRMR1 = DRMR1 *EXP( 292.564*TCF) +CCC DRMR2 = DRMR2 *EXP( 14.587*TCF) +CCC DRMR3 = DRMR3 *EXP( 307.907*TCF) +CCC DRMR4 = DRMR4 *EXP( 97.605*TCF) +CCC DRMR5 = DRMR5 *EXP( 98.523*TCF) +CCC DRMR6 = DRMR6 *EXP( 465.500*TCF) +CCC DRMR7 = DRMR7 *EXP( 324.425*TCF) +CCC DRMR8 = DRMR8 *EXP(2660.184*TCF) +CCC DRMR9 = DRMR9 *EXP(1617.178*TCF) +CCC DRMR10 = DRMR10 *EXP(1745.226*TCF) +CCC DRMR11 = DRMR11 *EXP(3691.328*TCF) +CCC DRMR12 = DRMR12 *EXP(1836.842*TCF) +CCC DRMR13 = DRMR13 *EXP(1967.938*TCF) +CCC ENDIF +C +C *** LIQUID PHASE ****************************************************** +C + CHNO3 = ZERO + CHCL = ZERO + CH2SO4 = ZERO + COH = ZERO + WATER = TINY +C + DO 20 I=1,NPAIR + MOLALR(I)=ZERO + GAMA(I) =0.1 + GAMIN(I) =GREAT + GAMOU(I) =GREAT + M0(I) =1d5 + 20 CONTINUE +C + DO 30 I=1,NPAIR + GAMA(I) = 0.1d0 + 30 CONTINUE +C + DO 40 I=1,NIONS + MOLAL(I)=ZERO +40 CONTINUE + COH = ZERO +C + DO 50 I=1,NGASAQ + GASAQ(I)=ZERO +50 CONTINUE +C +C *** SOLID PHASE ******************************************************* +C + CNH42S4= ZERO + CNH4HS4= ZERO + CNACL = ZERO + CNA2SO4= ZERO + CNANO3 = ZERO + CNH4NO3= ZERO + CNH4CL = ZERO + CNAHSO4= ZERO + CLC = ZERO +C +C *** GAS PHASE ********************************************************* +C + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO +C +C *** CALCULATE ZSR PARAMETERS ****************************************** +C + IRH = MIN (INT(RH*NZSR+0.5),NZSR) ! Position in ZSR arrays + IRH = MAX (IRH, 1) +C + M0(01) = AWSC(IRH) ! NACl + IF (M0(01) .LT. 100.0) THEN + IC = M0(01) + CALL KMTAB(IC,298.0, GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(01) = M0(01)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(02) = AWSS(IRH) ! (NA)2SO4 + IF (M0(02) .LT. 100.0) THEN + IC = 3.0*M0(02) + CALL KMTAB(IC,298.0, XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(02) = M0(02)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(03) = AWSN(IRH) ! NANO3 + IF (M0(03) .LT. 100.0) THEN + IC = M0(03) + CALL KMTAB(IC,298.0, XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX) + M0(03) = M0(03)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(04) = AWAS(IRH) ! (NH4)2SO4 + IF (M0(04) .LT. 100.0) THEN + IC = 3.0*M0(04) + CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX) + M0(04) = M0(04)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(05) = AWAN(IRH) ! NH4NO3 + IF (M0(05) .LT. 100.0) THEN + IC = M0(05) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX) + M0(05) = M0(05)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(06) = AWAC(IRH) ! NH4CL + IF (M0(06) .LT. 100.0) THEN + IC = M0(06) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX) + M0(06) = M0(06)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(07) = AWSA(IRH) ! 2H-SO4 + IF (M0(07) .LT. 100.0) THEN + IC = 3.0*M0(07) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX) + M0(07) = M0(07)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(08) = AWSA(IRH) ! H-HSO4 +CCC IF (M0(08) .LT. 100.0) THEN ! These are redundant, because M0(8) is not used +CCC IC = M0(08) +CCC CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) +CCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX) +CCCCCC CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX) +CCC M0(08) = M0(08)*EXP(LN10*(GI0-GII)) +CCC ENDIF +C + M0(09) = AWAB(IRH) ! NH4HSO4 + IF (M0(09) .LT. 100.0) THEN + IC = M0(09) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX) + M0(09) = M0(09)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(12) = AWSB(IRH) ! NAHSO4 + IF (M0(12) .LT. 100.0) THEN + IC = M0(12) + CALL KMTAB(IC,298.0, XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII) + M0(12) = M0(12)*EXP(LN10*(GI0-GII)) + ENDIF +C + M0(13) = AWLC(IRH) ! (NH4)3H(SO4)2 + IF (M0(13) .LT. 100.0) THEN + IC = 4.0*M0(13) + CALL KMTAB(IC,298.0, XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX) + G130 = 0.2*(3.0*GI0+2.0*GII) + CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX) + G13I = 0.2*(3.0*GI0+2.0*GII) + M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I)) + ENDIF +C +C *** OTHER INITIALIZATIONS ********************************************* +C + ICLACT = 0 + CALAOU = .TRUE. + CALAIN = .TRUE. + FRST = .TRUE. + SCASE = '??' + SULRATW = 2.D0 + NOFER = 0 + STKOFL =.FALSE. + DO 60 I=1,NERRMX + ERRSTK(I) =-999 + ERRMSG(I) = 'MESSAGE N/A' + 60 CONTINUE +C +C *** END OF SUBROUTINE ISOINIT3 ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ADJUST +C *** ADJUSTS FOR MASS BALANCE BETWEEN VOLATILE SPECIES AND SULFATE +C FIRST CALCULATE THE EXCESS OF EACH PRECURSOR, AND IF IT EXISTS, THEN +C ADJUST SEQUENTIALY AEROSOL PHASE SPECIES WHICH CONTAIN THE EXCESS +C PRECURSOR. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ADJUST (WI) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION WI(*) +C +C *** FOR AMMONIUM ***************************************************** +C + IF (IPROB.EQ.0) THEN ! Calculate excess (solution - input) + EXNH4 = GNH3 + MOLAL(3) + CNH4CL + CNH4NO3 + CNH4HS4 + & + 2D0*CNH42S4 + 3D0*CLC + & -WI(3) + ELSE + EXNH4 = MOLAL(3) + CNH4CL + CNH4NO3 + CNH4HS4 + 2D0*CNH42S4 + & + 3D0*CLC + & -WI(3) + + ENDIF + EXNH4 = MAX(EXNH4,ZERO) + IF (EXNH4.LT.TINY) GOTO 20 ! No excess NH4, go to next precursor +C + IF (MOLAL(3).GT.EXNH4) THEN ! Adjust aqueous phase NH4 + MOLAL(3) = MOLAL(3) - EXNH4 + GOTO 20 + ELSE + EXNH4 = EXNH4 - MOLAL(3) + MOLAL(3) = ZERO + ENDIF +C + IF (CNH4CL.GT.EXNH4) THEN ! Adjust NH4Cl(s) + CNH4CL = CNH4CL - EXNH4 ! more solid than excess + GHCL = GHCL + EXNH4 ! evaporate Cl to gas phase + GOTO 20 + ELSE ! less solid than excess + GHCL = GHCL + CNH4CL ! evaporate into gas phase + EXNH4 = EXNH4 - CNH4CL ! reduce excess + CNH4CL = ZERO ! zero salt concentration + ENDIF +C + IF (CNH4NO3.GT.EXNH4) THEN ! Adjust NH4NO3(s) + CNH4NO3 = CNH4NO3- EXNH4 ! more solid than excess + GHNO3 = GHNO3 + EXNH4 ! evaporate NO3 to gas phase + GOTO 20 + ELSE ! less solid than excess + GHNO3 = GHNO3 + CNH4NO3! evaporate into gas phase + EXNH4 = EXNH4 - CNH4NO3! reduce excess + CNH4NO3 = ZERO ! zero salt concentration + ENDIF +C + IF (CLC.GT.3d0*EXNH4) THEN ! Adjust (NH4)3H(SO4)2(s) + CLC = CLC - EXNH4/3d0 ! more solid than excess + GOTO 20 + ELSE ! less solid than excess + EXNH4 = EXNH4 - 3d0*CLC ! reduce excess + CLC = ZERO ! zero salt concentration + ENDIF +C + IF (CNH4HS4.GT.EXNH4) THEN ! Adjust NH4HSO4(s) + CNH4HS4 = CNH4HS4- EXNH4 ! more solid than excess + GOTO 20 + ELSE ! less solid than excess + EXNH4 = EXNH4 - CNH4HS4! reduce excess + CNH4HS4 = ZERO ! zero salt concentration + ENDIF +C + IF (CNH42S4.GT.EXNH4) THEN ! Adjust (NH4)2SO4(s) + CNH42S4 = CNH42S4- EXNH4 ! more solid than excess + GOTO 20 + ELSE ! less solid than excess + EXNH4 = EXNH4 - CNH42S4! reduce excess + CNH42S4 = ZERO ! zero salt concentration + ENDIF +C +C *** FOR NITRATE ****************************************************** +C + 20 IF (IPROB.EQ.0) THEN ! Calculate excess (solution - input) + EXNO3 = GHNO3 + MOLAL(7) + CNH4NO3 + & -WI(4) + ELSE + EXNO3 = MOLAL(7) + CNH4NO3 + & -WI(4) + ENDIF + EXNO3 = MAX(EXNO3,ZERO) + IF (EXNO3.LT.TINY) GOTO 30 ! No excess NO3, go to next precursor +C + IF (MOLAL(7).GT.EXNO3) THEN ! Adjust aqueous phase NO3 + MOLAL(7) = MOLAL(7) - EXNO3 + GOTO 30 + ELSE + EXNO3 = EXNO3 - MOLAL(7) + MOLAL(7) = ZERO + ENDIF +C + IF (CNH4NO3.GT.EXNO3) THEN ! Adjust NH4NO3(s) + CNH4NO3 = CNH4NO3- EXNO3 ! more solid than excess + GNH3 = GNH3 + EXNO3 ! evaporate NO3 to gas phase + GOTO 30 + ELSE ! less solid than excess + GNH3 = GNH3 + CNH4NO3! evaporate into gas phase + EXNO3 = EXNO3 - CNH4NO3! reduce excess + CNH4NO3 = ZERO ! zero salt concentration + ENDIF +C +C *** FOR CHLORIDE ***************************************************** +C + 30 IF (IPROB.EQ.0) THEN ! Calculate excess (solution - input) + EXCl = GHCL + MOLAL(4) + CNH4CL + & -WI(5) + ELSE + EXCl = MOLAL(4) + CNH4CL + & -WI(5) + ENDIF + EXCl = MAX(EXCl,ZERO) + IF (EXCl.LT.TINY) GOTO 40 ! No excess Cl, go to next precursor +C + IF (MOLAL(4).GT.EXCL) THEN ! Adjust aqueous phase Cl + MOLAL(4) = MOLAL(4) - EXCL + GOTO 40 + ELSE + EXCL = EXCL - MOLAL(4) + MOLAL(4) = ZERO + ENDIF +C + IF (CNH4CL.GT.EXCL) THEN ! Adjust NH4Cl(s) + CNH4CL = CNH4CL - EXCL ! more solid than excess + GHCL = GHCL + EXCL ! evaporate Cl to gas phase + GOTO 40 + ELSE ! less solid than excess + GHCL = GHCL + CNH4CL ! evaporate into gas phase + EXCL = EXCL - CNH4CL ! reduce excess + CNH4CL = ZERO ! zero salt concentration + ENDIF +C +C *** FOR SULFATE ****************************************************** +C + 40 EXS4 = MOLAL(5) + MOLAL(6) + 2.d0*CLC + CNH42S4 + CNH4HS4 + + & CNA2SO4 + CNAHSO4 - WI(2) + EXS4 = MAX(EXS4,ZERO) ! Calculate excess (solution - input) + IF (EXS4.LT.TINY) GOTO 50 ! No excess SO4, return +C + IF (MOLAL(6).GT.EXS4) THEN ! Adjust aqueous phase HSO4 + MOLAL(6) = MOLAL(6) - EXS4 + GOTO 50 + ELSE + EXS4 = EXS4 - MOLAL(6) + MOLAL(6) = ZERO + ENDIF +C + IF (MOLAL(5).GT.EXS4) THEN ! Adjust aqueous phase SO4 + MOLAL(5) = MOLAL(5) - EXS4 + GOTO 50 + ELSE + EXS4 = EXS4 - MOLAL(5) + MOLAL(5) = ZERO + ENDIF +C + IF (CLC.GT.2d0*EXS4) THEN ! Adjust (NH4)3H(SO4)2(s) + CLC = CLC - EXS4/2d0 ! more solid than excess + GNH3 = GNH3 +1.5d0*EXS4! evaporate NH3 to gas phase + GOTO 50 + ELSE ! less solid than excess + GNH3 = GNH3 + 1.5d0*CLC! evaporate NH3 to gas phase + EXS4 = EXS4 - 2d0*CLC ! reduce excess + CLC = ZERO ! zero salt concentration + ENDIF +C + IF (CNH4HS4.GT.EXS4) THEN ! Adjust NH4HSO4(s) + CNH4HS4 = CNH4HS4 - EXS4 ! more solid than excess + GNH3 = GNH3 + EXS4 ! evaporate NH3 to gas phase + GOTO 50 + ELSE ! less solid than excess + GNH3 = GNH3 + CNH4HS4 ! evaporate NH3 to gas phase + EXS4 = EXS4 - CNH4HS4 ! reduce excess + CNH4HS4 = ZERO ! zero salt concentration + ENDIF +C + IF (CNH42S4.GT.EXS4) THEN ! Adjust (NH4)2SO4(s) + CNH42S4 = CNH42S4- EXS4 ! more solid than excess + GNH3 = GNH3 + 2.d0*EXS4! evaporate NH3 to gas phase + GOTO 50 + ELSE ! less solid than excess + GNH3 = GNH3+2.d0*CNH42S4 ! evaporate NH3 to gas phase + EXS4 = EXS4 - CNH42S4 ! reduce excess + CNH42S4 = ZERO ! zero salt concentration + ENDIF +C +C *** RETURN ********************************************************** +C + 50 RETURN + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION GETASR +C *** CALCULATES THE LIMITING NH4+/SO4 RATIO OF A SULFATE POOR SYSTEM +C (i.e. SULFATE RATIO = 2.0) FOR GIVEN SO4 LEVEL AND RH +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION GETASR (SO4I, RHI) + PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS) + COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S) + DOUBLE PRECISION SO4I, RHI +CCC +CCC *** SOLVE USING FULL COMPUTATIONS, NOT LOOK-UP TABLES ************** +CCC +CCC W(2) = WAER(2) +CCC W(3) = WAER(2)*2.0001D0 +CCC CALL CALCA2 +CCC SULRATW = MOLAL(3)/WAER(2) +CCC CALL INIT1 (WI, RHI, TEMPI) ! Re-initialize COMMON BLOCK +C +C *** CALCULATE INDICES ************************************************ +C + RAT = SO4I/1.E-9 + A1 = INT(ALOG10(RAT)) ! Magnitude of RAT + IA1 = INT(RAT/2.5/10.0**A1) +C + INDS = 4.0*A1 + MIN(IA1,4) + INDS = MIN(MAX(0, INDS), NSO4S-1) + 1 ! SO4 component of IPOS +C + INDR = INT(99.0-RHI*100.0) + 1 + INDR = MIN(MAX(1, INDR), NRHS) ! RH component of IPOS +C +C *** GET VALUE AND RETURN ********************************************* +C + INDSL = INDS + INDSH = MIN(INDSL+1, NSO4S) + IPOSL = (INDSL-1)*NRHS + INDR ! Low position in array + IPOSH = (INDSH-1)*NRHS + INDR ! High position in array +C + WF = (SO4I-ASSO4(INDSL))/(ASSO4(INDSH)-ASSO4(INDSL) + 1e-7) + WF = MIN(MAX(WF, 0.0), 1.0) +C + GETASR = WF*ASRAT(IPOSH) + (1.0-WF)*ASRAT(IPOSL) +C +C *** END OF FUNCTION GETASR ******************************************* +C + RETURN + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** BLOCK DATA AERSR +C *** CONTAINS DATA FOR AEROSOL SULFATE RATIO ARRAY NEEDED IN FUNCTION +C GETASR +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + BLOCK DATA AERSR + PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS) + COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S) +C + DATA ASSO4/1.0E-9, 2.5E-9, 5.0E-9, 7.5E-9, 1.0E-8, + & 2.5E-8, 5.0E-8, 7.5E-8, 1.0E-7, 2.5E-7, + & 5.0E-7, 7.5E-7, 1.0E-6, 5.0E-6/ +C + DATA (ASRAT(I), I=1,100)/ + & 1.020464, 0.9998130, 0.9960167, 0.9984423, 1.004004, + & 1.010885, 1.018356, 1.026726, 1.034268, 1.043846, + & 1.052933, 1.062230, 1.062213, 1.080050, 1.088350, + & 1.096603, 1.104289, 1.111745, 1.094662, 1.121594, + & 1.268909, 1.242444, 1.233815, 1.232088, 1.234020, + & 1.238068, 1.243455, 1.250636, 1.258734, 1.267543, + & 1.276948, 1.286642, 1.293337, 1.305592, 1.314726, + & 1.323463, 1.333258, 1.343604, 1.344793, 1.355571, + & 1.431463, 1.405204, 1.395791, 1.393190, 1.394403, + & 1.398107, 1.403811, 1.411744, 1.420560, 1.429990, + & 1.439742, 1.449507, 1.458986, 1.468403, 1.477394, + & 1.487373, 1.495385, 1.503854, 1.512281, 1.520394, + & 1.514464, 1.489699, 1.480686, 1.478187, 1.479446, + & 1.483310, 1.489316, 1.497517, 1.506501, 1.515816, + & 1.524724, 1.533950, 1.542758, 1.551730, 1.559587, + & 1.568343, 1.575610, 1.583140, 1.590440, 1.596481, + & 1.567743, 1.544426, 1.535928, 1.533645, 1.535016, + & 1.539003, 1.545124, 1.553283, 1.561886, 1.570530, + & 1.579234, 1.587813, 1.595956, 1.603901, 1.611349, + & 1.618833, 1.625819, 1.632543, 1.639032, 1.645276/ + + DATA (ASRAT(I), I=101,200)/ + & 1.707390, 1.689553, 1.683198, 1.681810, 1.683490, + & 1.687477, 1.693148, 1.700084, 1.706917, 1.713507, + & 1.719952, 1.726190, 1.731985, 1.737544, 1.742673, + & 1.747756, 1.752431, 1.756890, 1.761141, 1.765190, + & 1.785657, 1.771851, 1.767063, 1.766229, 1.767901, + & 1.771455, 1.776223, 1.781769, 1.787065, 1.792081, + & 1.796922, 1.801561, 1.805832, 1.809896, 1.813622, + & 1.817292, 1.820651, 1.823841, 1.826871, 1.829745, + & 1.822215, 1.810497, 1.806496, 1.805898, 1.807480, + & 1.810684, 1.814860, 1.819613, 1.824093, 1.828306, + & 1.832352, 1.836209, 1.839748, 1.843105, 1.846175, + & 1.849192, 1.851948, 1.854574, 1.857038, 1.859387, + & 1.844588, 1.834208, 1.830701, 1.830233, 1.831727, + & 1.834665, 1.838429, 1.842658, 1.846615, 1.850321, + & 1.853869, 1.857243, 1.860332, 1.863257, 1.865928, + & 1.868550, 1.870942, 1.873208, 1.875355, 1.877389, + & 1.899556, 1.892637, 1.890367, 1.890165, 1.891317, + & 1.893436, 1.896036, 1.898872, 1.901485, 1.903908, + & 1.906212, 1.908391, 1.910375, 1.912248, 1.913952, + & 1.915621, 1.917140, 1.918576, 1.919934, 1.921220/ + + DATA (ASRAT(I), I=201,280)/ + & 1.928264, 1.923245, 1.921625, 1.921523, 1.922421, + & 1.924016, 1.925931, 1.927991, 1.929875, 1.931614, + & 1.933262, 1.934816, 1.936229, 1.937560, 1.938769, + & 1.939951, 1.941026, 1.942042, 1.943003, 1.943911, + & 1.941205, 1.937060, 1.935734, 1.935666, 1.936430, + & 1.937769, 1.939359, 1.941061, 1.942612, 1.944041, + & 1.945393, 1.946666, 1.947823, 1.948911, 1.949900, + & 1.950866, 1.951744, 1.952574, 1.953358, 1.954099, + & 1.948985, 1.945372, 1.944221, 1.944171, 1.944850, + & 1.946027, 1.947419, 1.948902, 1.950251, 1.951494, + & 1.952668, 1.953773, 1.954776, 1.955719, 1.956576, + & 1.957413, 1.958174, 1.958892, 1.959571, 1.960213, + & 1.977193, 1.975540, 1.975023, 1.975015, 1.975346, + & 1.975903, 1.976547, 1.977225, 1.977838, 1.978401, + & 1.978930, 1.979428, 1.979879, 1.980302, 1.980686, + & 1.981060, 1.981401, 1.981722, 1.982025, 1.982312/ +C +C *** END OF BLOCK DATA AERSR ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCHA +C *** CALCULATES CHLORIDES SPECIATION +C +C HYDROCHLORIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, +C AND DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE +C HYDROCHLORIC ACID DISSOLVED IS CALCULATED FROM THE +C HCL(G) <-> (H+) + (CL-) +C EQUILIBRIUM, USING THE (H+) FROM THE SULFATES. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCHA + INCLUDE 'isrpia.inc' + DOUBLE PRECISION KAPA +CC CHARACTER ERRINF*40 +C +C *** CALCULATE HCL DISSOLUTION ***************************************** +C + X = W(5) + DELT = ZERO + IF (WATER.GT.TINY) THEN + KAPA = MOLAL(1) +! ALFA = XK3*R*TEMP*(WATER/GAMA(11))**2.0 +! DIAK = SQRT( (KAPA+ALFA)**2.0 + 4.0*ALFA*X) +! DELT = 0.5*(-(KAPA+ALFA) + DIAK) +CC IF (DELT/KAPA.GT.0.1d0) THEN +CC WRITE (ERRINF,'(1PE10.3)') DELT/KAPA*100.0 +CC CALL PUSHERR (0033, ERRINF) +CC ENDIF + ALFA = XK3*R*TEMP*(WATER*WATER/(GAMA(11)*GAMA(11))) + BB = KAPA + ALFA + DIAK = SQRT( BB*BB + 4.0*ALFA*X) + DELT = 0.5*(-BB + DIAK) + ENDIF +C +C *** CALCULATE HCL SPECIATION IN THE GAS PHASE ************************* +C + GHCL = MAX(X-DELT, ZERO) ! GAS HCL +C +C *** CALCULATE HCL SPECIATION IN THE LIQUID PHASE ********************** +C + MOLAL(4) = DELT ! CL- + MOLAL(1) = MOLAL(1) + DELT ! H+ +C + RETURN +C +C *** END OF SUBROUTINE CALCHA ****************************************** +C + END + + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCHAP +C *** CALCULATES CHLORIDES SPECIATION +C +C HYDROCHLORIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, +C THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. +C THE HYDROCHLORIC ACID DISSOLVED IS CALCULATED FROM THE +C HCL(G) -> HCL(AQ) AND HCL(AQ) -> (H+) + (CL-) +C EQUILIBRIA, USING (H+) FROM THE SULFATES. +C +C THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOVER +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCHAP + INCLUDE 'isrpia.inc' +C +C *** IS THERE A LIQUID PHASE? ****************************************** +C + IF (WATER.LE.TINY) RETURN +C +C *** CALCULATE HCL SPECIATION IN THE GAS PHASE ************************* +C + CALL CALCCLAQ (MOLAL(4), MOLAL(1), DELT) +! ALFA = XK3*R*TEMP*(WATER/GAMA(11))**2.0 + ALFA = XK3*R*TEMP*(WATER*WATER/(GAMA(11)*GAMA(11))) + GASAQ(3) = DELT + MOLAL(1) = MOLAL(1) - DELT + MOLAL(4) = MOLAL(4) - DELT + GHCL = MOLAL(1)*MOLAL(4)/ALFA +C + RETURN +C +C *** END OF SUBROUTINE CALCHAP ***************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNA +C *** CALCULATES NITRATES SPECIATION +C +C NITRIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, THAT +C DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE NITRIC +C ACID DISSOLVED IS CALCULATED FROM THE HNO3(G) -> (H+) + (NO3-) +C EQUILIBRIUM, USING THE (H+) FROM THE SULFATES. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNA + INCLUDE 'isrpia.inc' + DOUBLE PRECISION KAPA +CC CHARACTER ERRINF*40 +C +C *** CALCULATE HNO3 DISSOLUTION **************************************** +C + X = W(4) + DELT = ZERO + IF (WATER.GT.TINY) THEN + KAPA = MOLAL(1) +! ALFA = XK4*R*TEMP*(WATER/GAMA(10))**2.0 +! DIAK = SQRT( (KAPA+ALFA)**2.0 + 4.0*ALFA*X) +! DELT = 0.5*(-(KAPA+ALFA) + DIAK) +CC IF (DELT/KAPA.GT.0.1d0) THEN +CC WRITE (ERRINF,'(1PE10.3)') DELT/KAPA*100.0 +CC CALL PUSHERR (0019, ERRINF) ! WARNING ERROR: NO SOLUTION +CC ENDIF + ALFA = XK4*R*TEMP*(WATER*WATER/(GAMA(10)*GAMA(10))) + BB = KAPA + ALFA + DIAK = SQRT( BB*BB + 4.0*ALFA*X) + DELT = 0.5*(-BB + DIAK) + ENDIF +C +C *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************ +C + GHNO3 = MAX(X-DELT, ZERO) ! GAS HNO3 +C +C *** CALCULATE HNO3 SPECIATION IN THE LIQUID PHASE ********************* +C + MOLAL(7) = DELT ! NO3- + MOLAL(1) = MOLAL(1) + DELT ! H+ +C + RETURN +C +C *** END OF SUBROUTINE CALCNA ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNAP +C *** CALCULATES NITRATES SPECIATION +C +C NITRIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, THAT +C DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE NITRIC +C ACID DISSOLVED IS CALCULATED FROM THE HNO3(G) -> HNO3(AQ) AND +C HNO3(AQ) -> (H+) + (CL-) EQUILIBRIA, USING (H+) FROM THE SULFATES. +C +C THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOVER +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNAP + INCLUDE 'isrpia.inc' +C +C *** IS THERE A LIQUID PHASE? ****************************************** +C + IF (WATER.LE.TINY) RETURN +C +C *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************ +C + CALL CALCNIAQ (MOLAL(7), MOLAL(1), DELT) +! ALFA = XK4*R*TEMP*(WATER/GAMA(10))**2.0 + ALFA = XK4*R*TEMP*(WATER*WATER/(GAMA(10)*GAMA(10))) + GASAQ(3) = DELT + MOLAL(1) = MOLAL(1) - DELT + MOLAL(7) = MOLAL(7) - DELT + GHNO3 = MOLAL(1)*MOLAL(7)/ALFA + +! write (*,*) ALFA, MOLAL(1), MOLAL(7), GHNO3, DELT +C + RETURN +C +C *** END OF SUBROUTINE CALCNAP ***************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNH3 +C *** CALCULATES AMMONIA IN GAS PHASE +C +C AMMONIA IN THE GAS PHASE IS ASSUMED A MINOR SPECIES, THAT +C DOES NOT SIGNIFICANTLY PERTURB THE AEROSOL EQUILIBRIUM. +C AMMONIA GAS IS CALCULATED FROM THE NH3(g) + (H+)(l) <==> (NH4+)(l) +C EQUILIBRIUM, USING (H+), (NH4+) FROM THE AEROSOL SOLUTION. +C +C THIS IS THE VERSION USED BY THE DIRECT PROBLEM +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNH3 + INCLUDE 'isrpia.inc' +C +C *** IS THERE A LIQUID PHASE? ****************************************** +C + IF (WATER.LE.TINY) RETURN +C +C *** CALCULATE NH3 SUBLIMATION ***************************************** +C +! A1 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A1 = (XK2/XKW)*R*TEMP*GAMA(10)*GAMA(10)/(GAMA(5)*GAMA(5)) + CHI1 = MOLAL(3) + CHI2 = MOLAL(1) +C + BB =(CHI2 + ONE/A1) ! a=1; b!=1; c!=1 + CC =-CHI1/A1 + DIAK = SQRT(BB*BB - 4.D0*CC) ! Always > 0 + PSI = 0.5*(-BB + DIAK) ! One positive root + PSI = MAX(TINY, MIN(PSI,CHI1))! Constrain in acceptable range +C +C *** CALCULATE NH3 SPECIATION IN THE GAS PHASE ************************* +C + GNH3 = PSI ! GAS HNO3 +C +C *** CALCULATE NH3 AFFECT IN THE LIQUID PHASE ************************** +C + MOLAL(3) = CHI1 - PSI ! NH4+ + MOLAL(1) = CHI2 + PSI ! H+ +C + RETURN +C +C *** END OF SUBROUTINE CALCNH3 ***************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNH3P +C *** CALCULATES AMMONIA IN GAS PHASE +C +C AMMONIA GAS IS CALCULATED FROM THE NH3(g) + (H+)(l) <==> (NH4+)(l) +C EQUILIBRIUM, USING (H+), (NH4+) FROM THE AEROSOL SOLUTION. +C +C THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOLVER +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNH3P + INCLUDE 'isrpia.inc' +C +C *** IS THERE A LIQUID PHASE? ****************************************** +C + IF (WATER.LE.TINY) RETURN +C +C *** CALCULATE NH3 GAS PHASE CONCENTRATION ***************************** +C +! A1 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A1 = (XK2/XKW)*R*TEMP*(GAMA(10)*GAMA(10)/(GAMA(5)*GAMA(5))) + GNH3 = MOLAL(3)/MOLAL(1)/A1 +C + RETURN +C +C *** END OF SUBROUTINE CALCNH3P **************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNHA +C +C THIS SUBROUTINE CALCULATES THE DISSOLUTION OF HCL, HNO3 AT +C THE PRESENCE OF (H,SO4). HCL, HNO3 ARE CONSIDERED MINOR SPECIES, +C THAT DO NOT SIGNIFICANTLY AFFECT THE EQUILIBRIUM POINT. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNHA + INCLUDE 'isrpia.inc' + DOUBLE PRECISION M1, M2, M3 + CHARACTER ERRINF*40 +C +C *** SPECIAL CASE; WATER=ZERO ****************************************** +C + IF (WATER.LE.TINY) THEN + GOTO 55 +C +C *** SPECIAL CASE; HCL=HNO3=ZERO *************************************** +C + ELSEIF (W(5).LE.TINY .AND. W(4).LE.TINY) THEN + GOTO 60 +C +C *** SPECIAL CASE; HCL=ZERO ******************************************** +C + ELSE IF (W(5).LE.TINY) THEN + CALL CALCNA ! CALL HNO3 DISSOLUTION ROUTINE + GOTO 60 +C +C *** SPECIAL CASE; HNO3=ZERO ******************************************* +C + ELSE IF (W(4).LE.TINY) THEN + CALL CALCHA ! CALL HCL DISSOLUTION ROUTINE + GOTO 60 + ENDIF +C +C *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** +C +! A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 ! HNO3 +! A4 = XK3*R*TEMP*(WATER/GAMA(11))**2.0 ! HCL + A3 = XK4*R*TEMP*(WATER*WATER/(GAMA(10)*GAMA(10))) ! HNO3 + A4 = XK3*R*TEMP*(WATER*WATER/(GAMA(11)*GAMA(11))) ! HCL +C +C *** CALCULATE CUBIC EQUATION COEFFICIENTS ***************************** +C + DELCL = ZERO + DELNO = ZERO +C + OMEGA = MOLAL(1) ! H+ + CHI3 = W(4) ! HNO3 + CHI4 = W(5) ! HCL +C + C1 = A3*CHI3 + C2 = A4*CHI4 + C3 = A3 - A4 +C + M1 = (C1 + C2 + (OMEGA+A4)*C3)/C3 +! M2 = ((OMEGA+A4)*C2 - A4*C3*CHI4)/C3 +! M3 =-A4*C2*CHI4/C3 + M2 = (OMEGA+A4-C3)*C2/C3 + M3 =-C2*C2/C3 +C +C *** CALCULATE ROOTS *************************************************** +C + CALL POLY3 (M1, M2, M3, DELCL, ISLV) ! HCL DISSOLUTION + IF (ISLV.NE.0) THEN +! In my tests, the cubic solver poly3 never finds a root. The +! cubic and quadratic terms are always negligible compared to the linear +! and constant terms. I leave in the call to POLY3 for now and compute +! an alternate solution when it fails. +! DELCL = TINY ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT +! WRITE (ERRINF,'(1PE7.1)') TINY +! CALL PUSHERR (0022, ERRINF) ! WARNING ERROR: NO SOLUTION + DELCL = MAX(-M3/M2,TINY) + ENDIF + DELCL = MIN(DELCL, CHI4) +C + DELNO = C1*DELCL/(C2 + C3*DELCL) + DELNO = MIN(DELNO, CHI3) +C + IF (DELCL.LT.ZERO .OR. DELNO.LT.ZERO .OR. + & DELCL.GT.CHI4 .OR. DELNO.GT.CHI3 ) THEN +! should never get here . . . + DELCL = TINY ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT + DELNO = TINY + WRITE (ERRINF,'(1PE7.1)') TINY + CALL PUSHERR (0022, ERRINF) ! WARNING ERROR: NO SOLUTION + ENDIF +CCC +CCC *** COMPARE DELTA TO TOTAL H+ ; ESTIMATE EFFECT TO HSO4 *************** +CCC +CC IF ((DELCL+DELNO)/MOLAL(1).GT.0.1d0) THEN +CC WRITE (ERRINF,'(1PE10.3)') (DELCL+DELNO)/MOLAL(1)*100.0 +CC CALL PUSHERR (0021, ERRINF) +CC ENDIF +C +C *** EFFECT ON LIQUID PHASE ******************************************** +C +50 MOLAL(1) = MOLAL(1) + (DELNO+DELCL) ! H+ CHANGE + MOLAL(4) = MOLAL(4) + DELCL ! CL- CHANGE + MOLAL(7) = MOLAL(7) + DELNO ! NO3- CHANGE +C +C *** EFFECT ON GAS PHASE *********************************************** +C +55 GHCL = MAX(W(5) - MOLAL(4), TINY) + GHNO3 = MAX(W(4) - MOLAL(7), TINY) +C +60 RETURN +C +C *** END OF SUBROUTINE CALCNHA ***************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNHP +C +C THIS SUBROUTINE CALCULATES THE GAS PHASE NITRIC AND HYDROCHLORIC +C ACID. CONCENTRATIONS ARE CALCULATED FROM THE DISSOLUTION +C EQUILIBRIA, USING (H+), (Cl-), (NO3-) IN THE AEROSOL PHASE. +C +C THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOLVER +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNHP + INCLUDE 'isrpia.inc' +C +C *** IS THERE A LIQUID PHASE? ****************************************** +C + IF (WATER.LE.TINY) RETURN +C +C *** CALCULATE EQUILIBRIUM CONSTANTS *********************************** +C +! A3 = XK3*R*TEMP*(WATER/GAMA(11))**2.0 +! A4 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 + A3 = XK3*R*TEMP*(WATER*WATER/(GAMA(11)*GAMA(11))) + A4 = XK4*R*TEMP*(WATER*WATER/(GAMA(10)*GAMA(10))) + MOLAL(1) = MOLAL(1) + WAER(4) + WAER(5) ! H+ increases because NO3, Cl are added. +C +C *** CALCULATE CONCENTRATIONS ****************************************** +C *** ASSUME THAT 'DELT' FROM HNO3 >> 'DELT' FROM HCL +C + CALL CALCNIAQ (WAER(4), MOLAL(1)+MOLAL(7)+MOLAL(4), DELT) + MOLAL(1) = MOLAL(1) - DELT + MOLAL(7) = WAER(4) - DELT ! NO3- = Waer(4) minus any turned into (HNO3aq) + GASAQ(3) = DELT +C + CALL CALCCLAQ (WAER(5), MOLAL(1)+MOLAL(7)+MOLAL(4), DELT) + MOLAL(1) = MOLAL(1) - DELT + MOLAL(4) = WAER(5) - DELT ! Cl- = Waer(4) minus any turned into (HNO3aq) + GASAQ(2) = DELT +C + GHNO3 = MOLAL(1)*MOLAL(7)/A4 + GHCL = MOLAL(1)*MOLAL(4)/A3 +C + RETURN +C +C *** END OF SUBROUTINE CALCNHP ***************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCAMAQ +C *** THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCAMAQ (NH4I, OHI, DELT) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NH4I +CC CHARACTER ERRINF*40 +C +C *** EQUILIBRIUM CONSTANTS +C +! A22 = XK22/XKW/WATER*(GAMA(8)/GAMA(9))**2. ! GAMA(NH3) ASSUMED 1 + A22 = XK22/XKW/WATER*(GAMA(8)*GAMA(8)/(GAMA(9)*GAMA(9))) ! GAMA(NH3) ASSUMED 1 + AKW = XKW *RH*WATER*WATER +C +C *** FIND ROOT +C + OM1 = NH4I + OM2 = OHI + BB =-(OM1+OM2+A22*AKW) + CC = OM1*OM2 + DD = SQRT(BB*BB-4.D0*CC) + + DEL1 = 0.5D0*(-BB - DD) + DEL2 = 0.5D0*(-BB + DD) +C +C *** GET APPROPRIATE ROOT. +C + IF (DEL1.LT.ZERO) THEN + IF (DEL2.GT.NH4I .OR. DEL2.GT.OHI) THEN + DELT = ZERO + ELSE + DELT = DEL2 + ENDIF + ELSE + DELT = DEL1 + ENDIF +CC +CC *** COMPARE DELTA TO TOTAL NH4+ ; ESTIMATE EFFECT ********************* +CC +CC IF (DELTA/HYD.GT.0.1d0) THEN +CC WRITE (ERRINF,'(1PE10.3)') DELTA/HYD*100.0 +CC CALL PUSHERR (0020, ERRINF) +CC ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCAMAQ **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCAMAQ2 +C +C THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCAMAQ2 (GGNH3, NH4I, OHI, NH3AQ) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NH4I, NH3AQ +C +C *** EQUILIBRIUM CONSTANTS +C +! A22 = XK22/XKW/WATER*(GAMA(8)/GAMA(9))**2. ! GAMA(NH3) ASSUMED 1 + A22 = XK22/XKW/WATER*(GAMA(8)*GAMA(8)/(GAMA(9)*GAMA(9))) ! GAMA(NH3) ASSUMED 1 + AKW = XKW *RH*WATER*WATER +C +C *** FIND ROOT +C + ALF1 = NH4I - GGNH3 + ALF2 = GGNH3 + BB = ALF1 + A22*AKW + CC =-A22*AKW*ALF2 + DEL = 0.5D0*(-BB + SQRT(BB*BB-4.D0*CC)) +C +C *** ADJUST CONCENTRATIONS +C + NH4I = ALF1 + DEL + OHI = DEL + IF (OHI.LE.TINY) OHI = SQRT(AKW) ! If solution is neutral. + NH3AQ = ALF2 - DEL +C + RETURN +C +C *** END OF SUBROUTINE CALCAMAQ2 **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCCLAQ +C +C THIS SUBROUTINE CALCULATES THE HCL(aq) GENERATED FROM (H+,CL-). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCCLAQ (CLI, HI, DELT) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION CLI +C +C *** EQUILIBRIUM CONSTANTS +C +! A32 = XK32*WATER/(GAMA(11))**2. ! GAMA(HCL) ASSUMED 1 + A32 = XK32*WATER/(GAMA(11)*GAMA(11)) ! GAMA(HCL) ASSUMED 1 +C +C *** FIND ROOT +C + OM1 = CLI + OM2 = HI + BB =-(OM1+OM2+A32) + CC = OM1*OM2 + DD = SQRT(BB*BB-4.D0*CC) + + DEL1 = 0.5D0*(-BB - DD) + DEL2 = 0.5D0*(-BB + DD) +C +C *** GET APPROPRIATE ROOT. +C + IF (DEL1.LT.ZERO) THEN + IF (DEL2.LT.ZERO .OR. DEL2.GT.CLI .OR. DEL2.GT.HI) THEN + DELT = ZERO + ELSE + DELT = DEL2 + ENDIF + ELSE + DELT = DEL1 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCCLAQ **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCCLAQ2 +C +C THIS SUBROUTINE CALCULATES THE HCL(aq) GENERATED FROM (H+,CL-). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCCLAQ2 (GGCL, CLI, HI, CLAQ) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION CLI +C +C *** EQUILIBRIUM CONSTANTS +C +! A32 = XK32*WATER/(GAMA(11))**2. ! GAMA(HCL) ASSUMED 1 + A32 = XK32*WATER/(GAMA(11)*GAMA(11)) ! GAMA(HCL) ASSUMED 1 + AKW = XKW *RH*WATER*WATER +C +C *** FIND ROOT +C + ALF1 = CLI - GGCL + ALF2 = GGCL + COEF = (ALF1+A32) + DEL1 = 0.5*(-COEF + SQRT(COEF*COEF+4.D0*A32*ALF2)) +C +C *** CORRECT CONCENTRATIONS +C + CLI = ALF1 + DEL1 + HI = DEL1 + IF (HI.LE.TINY) HI = SQRT(AKW) ! If solution is neutral. + CLAQ = ALF2 - DEL1 +C + RETURN +C +C *** END OF SUBROUTINE CALCCLAQ2 **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNIAQ +C +C THIS SUBROUTINE CALCULATES THE HNO3(aq) GENERATED FROM (H,NO3-). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNIAQ (NO3I, HI, DELT) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NO3I, HI, DELT +C +C *** EQUILIBRIUM CONSTANTS +C +! A42 = XK42*WATER/(GAMA(10))**2. ! GAMA(HNO3) ASSUMED 1 + A42 = XK42*WATER/(GAMA(10)*GAMA(10)) ! GAMA(HNO3) ASSUMED 1 +C +C *** FIND ROOT +C + OM1 = NO3I + OM2 = HI + BB =-(OM1+OM2+A42) + CC = OM1*OM2 + DD = SQRT(BB*BB-4.D0*CC) + + DEL1 = 0.5D0*(-BB - DD) + DEL2 = 0.5D0*(-BB + DD) +C +C *** GET APPROPRIATE ROOT. +C + IF (DEL1.LT.ZERO .OR. DEL1.GT.HI .OR. DEL1.GT.NO3I) THEN + print *, DELT + DELT = ZERO + ELSE + DELT = DEL1 + RETURN + ENDIF +C + IF (DEL2.LT.ZERO .OR. DEL2.GT.NO3I .OR. DEL2.GT.HI) THEN + DELT = ZERO + ELSE + DELT = DEL2 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCNIAQ **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCNIAQ2 +C +C THIS SUBROUTINE CALCULATES THE UNDISSOCIATED HNO3(aq) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NO3I, NO3AQ +C +C *** EQUILIBRIUM CONSTANTS +C +! A42 = XK42*WATER/(GAMA(10))**2. ! GAMA(HNO3) ASSUMED 1 + A42 = XK42*WATER/(GAMA(10)*GAMA(10)) ! GAMA(HNO3) ASSUMED 1 + AKW = XKW *RH*WATER*WATER +C +C *** FIND ROOT +C + ALF1 = NO3I - GGNO3 + ALF2 = GGNO3 + ALF3 = HI +C + BB = ALF3 + ALF1 + A42 + CC = ALF3*ALF1 - A42*ALF2 + DEL1 = 0.5*(-BB + SQRT(BB*BB-4.D0*CC)) +C +C *** CORRECT CONCENTRATIONS +C + NO3I = ALF1 + DEL1 + HI = ALF3 + DEL1 + IF (HI.LE.TINY) HI = SQRT(AKW) ! If solution is neutral. + NO3AQ = ALF2 - DEL1 +C + RETURN +C +C *** END OF SUBROUTINE CALCNIAQ2 **************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCMR +C *** THIS SUBROUTINE CALCULATES: +C 1. ION PAIR CONCENTRATIONS (FROM [MOLAR] ARRAY) +C 2. WATER CONTENT OF LIQUID AEROSOL PHASE (FROM ZSR CORRELATION) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCMR + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 + CHARACTER SC*1 +C +C *** CALCULATE ION PAIR CONCENTRATIONS ACCORDING TO SPECIFIC CASE **** +C + SC =SCASE(1:1) ! SULRAT & SODRAT case +C +C *** NH4-SO4 SYSTEM ; SULFATE POOR CASE +C + IF (SC.EQ.'A') THEN + MOLALR(4) = MOLAL(5)+MOLAL(6) ! (NH4)2SO4 - CORRECT FOR SO4 TO HSO4 +C +C *** NH4-SO4 SYSTEM ; SULFATE RICH CASE ; NO FREE ACID +C + ELSE IF (SC.EQ.'B') THEN + SO4I = MOLAL(5)-MOLAL(1) ! CORRECT FOR HSO4 DISSOCIATION + HSO4I = MOLAL(6)+MOLAL(1) + IF (SO4I.LT.HSO4I) THEN + MOLALR(13) = SO4I ! [LC] = [SO4] + MOLALR(9) = MAX(HSO4I-SO4I, ZERO) ! NH4HSO4 + ELSE + MOLALR(13) = HSO4I ! [LC] = [HSO4] + MOLALR(4) = MAX(SO4I-HSO4I, ZERO) ! (NH4)2SO4 + ENDIF +C +C *** NH4-SO4 SYSTEM ; SULFATE RICH CASE ; FREE ACID +C + ELSE IF (SC.EQ.'C') THEN + MOLALR(9) = MOLAL(3) ! NH4HSO4 + MOLALR(7) = MAX(W(2)-W(3), ZERO) ! H2SO4 +C +C *** NH4-SO4-NO3 SYSTEM ; SULFATE POOR CASE +C + ELSE IF (SC.EQ.'D') THEN + MOLALR(4) = MOLAL(5) + MOLAL(6) ! (NH4)2SO4 + AML5 = MOLAL(3)-2.D0*MOLALR(4) ! "free" NH4 + MOLALR(5) = MAX(MIN(AML5,MOLAL(7)), ZERO)! NH4NO3 = MIN("free", NO3) +C +C *** NH4-SO4-NO3 SYSTEM ; SULFATE RICH CASE ; NO FREE ACID +C + ELSE IF (SC.EQ.'E') THEN + SO4I = MAX(MOLAL(5)-MOLAL(1),ZERO) ! FROM HSO4 DISSOCIATION + HSO4I = MOLAL(6)+MOLAL(1) + IF (SO4I.LT.HSO4I) THEN + MOLALR(13) = SO4I ! [LC] = [SO4] + MOLALR(9) = MAX(HSO4I-SO4I, ZERO) ! NH4HSO4 + ELSE + MOLALR(13) = HSO4I ! [LC] = [HSO4] + MOLALR(4) = MAX(SO4I-HSO4I, ZERO) ! (NH4)2SO4 + ENDIF +C +C *** NH4-SO4-NO3 SYSTEM ; SULFATE RICH CASE ; FREE ACID +C + ELSE IF (SC.EQ.'F') THEN + MOLALR(9) = MOLAL(3) ! NH4HSO4 + MOLALR(7) = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3),ZERO) ! H2SO4 +C +C *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE POOR ; SODIUM POOR CASE +C + ELSE IF (SC.EQ.'G') THEN + MOLALR(2) = 0.5*MOLAL(2) ! NA2SO4 + TOTS4 = MOLAL(5)+MOLAL(6) ! Total SO4 + MOLALR(4) = MAX(TOTS4 - MOLALR(2), ZERO) ! (NH4)2SO4 + FRNH4 = MAX(MOLAL(3) - 2.D0*MOLALR(4), ZERO) + MOLALR(5) = MIN(MOLAL(7),FRNH4) ! NH4NO3 + FRNH4 = MAX(FRNH4 - MOLALR(5), ZERO) + MOLALR(6) = MIN(MOLAL(4), FRNH4) ! NH4CL +C +C *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE POOR ; SODIUM RICH CASE +C *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ +C + ELSE IF (SC.EQ.'H') THEN + MOLALR(1) = PSI7 ! NACL + MOLALR(2) = PSI1 ! NA2SO4 + MOLALR(3) = PSI8 ! NANO3 + MOLALR(4) = ZERO ! (NH4)2SO4 + FRNO3 = MAX(MOLAL(7) - MOLALR(3), ZERO) ! "FREE" NO3 + FRCL = MAX(MOLAL(4) - MOLALR(1), ZERO) ! "FREE" CL + MOLALR(5) = MIN(MOLAL(3),FRNO3) ! NH4NO3 + FRNH4 = MAX(MOLAL(3) - MOLALR(5), ZERO) ! "FREE" NH3 + MOLALR(6) = MIN(FRCL, FRNH4) ! NH4CL +C +C *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE RICH CASE ; NO FREE ACID +C *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/ +C + ELSE IF (SC.EQ.'I') THEN + MOLALR(04) = PSI5 ! (NH4)2SO4 + MOLALR(02) = PSI4 ! NA2SO4 + MOLALR(09) = PSI1 ! NH4HSO4 + MOLALR(12) = PSI3 ! NAHSO4 + MOLALR(13) = PSI2 ! LC +C +C *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE RICH CASE ; FREE ACID +C + ELSE IF (SC.EQ.'J') THEN + MOLALR(09) = MOLAL(3) ! NH4HSO4 + MOLALR(12) = MOLAL(2) ! NAHSO4 + MOLALR(07) = MOLAL(5)+MOLAL(6)-MOLAL(3)-MOLAL(2) ! H2SO4 + MOLALR(07) = MAX(MOLALR(07),ZERO) +C +C ======= REVERSE PROBLEMS =========================================== +C +C *** NH4-SO4-NO3 SYSTEM ; SULFATE POOR CASE +C + ELSE IF (SC.EQ.'N') THEN + MOLALR(4) = MOLAL(5) + MOLAL(6) ! (NH4)2SO4 + AML5 = WAER(3)-2.D0*MOLALR(4) ! "free" NH4 + MOLALR(5) = MAX(MIN(AML5,WAER(4)), ZERO) ! NH4NO3 = MIN("free", NO3) +C +C *** NH4-SO4-NO3-NA-CL SYSTEM ; SULFATE POOR, SODIUM POOR CASE +C + ELSE IF (SC.EQ.'Q') THEN + MOLALR(2) = PSI1 ! NA2SO4 + MOLALR(4) = PSI6 ! (NH4)2SO4 + MOLALR(5) = PSI5 ! NH4NO3 + MOLALR(6) = PSI4 ! NH4CL +C +C *** NH4-SO4-NO3-NA-CL SYSTEM ; SULFATE POOR, SODIUM RICH CASE +C + ELSE IF (SC.EQ.'R') THEN + MOLALR(1) = PSI3 ! NACL + MOLALR(2) = PSI1 ! NA2SO4 + MOLALR(3) = PSI2 ! NANO3 + MOLALR(4) = ZERO ! (NH4)2SO4 + MOLALR(5) = PSI5 ! NH4NO3 + MOLALR(6) = PSI4 ! NH4CL +C +C *** UNKNOWN CASE +C + ELSE + CALL PUSHERR (1001, ' ') ! FATAL ERROR: CASE NOT SUPPORTED + ENDIF +C +C *** CALCULATE WATER CONTENT ; ZSR CORRELATION *********************** +C + WATER = ZERO + DO 10 I=1,NPAIR + WATER = WATER + MOLALR(I)/M0(I) +10 CONTINUE + WATER = MAX(WATER, TINY) +C + RETURN +C +C *** END OF SUBROUTINE CALCMR ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCMDRH +C +C THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL +C DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED +C SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE +C 'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCMDRH (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE) + INCLUDE 'isrpia.inc' + EXTERNAL DRYCASE, LIQCASE +C +C *** FIND WEIGHT FACTOR ********************************************** +C + IF (WFTYP.EQ.0) THEN + WF = ONE + ELSEIF (WFTYP.EQ.1) THEN + WF = 0.5D0 + ELSE + WF = (RHLIQ-RHI)/(RHLIQ-RHDRY) + ENDIF + ONEMWF = ONE - WF +C +C *** FIND FIRST SECTION ; DRY ONE ************************************ +C + CALL DRYCASE + IF (ABS(ONEMWF).LE.1D-5) GOTO 200 ! DRY AEROSOL +C + CNH42SO = CNH42S4 ! FIRST (DRY) SOLUTION + CNH4HSO = CNH4HS4 + CLCO = CLC + CNH4N3O = CNH4NO3 + CNH4CLO = CNH4CL + CNA2SO = CNA2SO4 + CNAHSO = CNAHSO4 + CNANO = CNANO3 + CNACLO = CNACL + GNH3O = GNH3 + GHNO3O = GHNO3 + GHCLO = GHCL +C +C *** FIND SECOND SECTION ; DRY & LIQUID ****************************** +C + CNH42S4 = ZERO + CNH4HS4 = ZERO + CLC = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNA2SO4 = ZERO + CNAHSO4 = ZERO + CNANO3 = ZERO + CNACL = ZERO + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO + CALL LIQCASE ! SECOND (LIQUID) SOLUTION +C +C *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL +C + IF (WATER.LE.TINY) THEN + DO 100 I=1,NIONS + MOLAL(I)= ZERO ! Aqueous phase + 100 CONTINUE + WATER = ZERO +C + CNH42S4 = CNH42SO ! Solid phase + CNA2SO4 = CNA2SO + CNAHSO4 = CNAHSO + CNH4HS4 = CNH4HSO + CLC = CLCO + CNH4NO3 = CNH4N3O + CNANO3 = CNANO + CNACL = CNACLO + CNH4CL = CNH4CLO +C + GNH3 = GNH3O ! Gas phase + GHNO3 = GHNO3O + GHCL = GHCLO +C + GOTO 200 + ENDIF +C +C *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. +C + DAMSUL = CNH42SO - CNH42S4 + DSOSUL = CNA2SO - CNA2SO4 + DAMBIS = CNH4HSO - CNH4HS4 + DSOBIS = CNAHSO - CNAHSO4 + DLC = CLCO - CLC + DAMNIT = CNH4N3O - CNH4NO3 + DAMCHL = CNH4CLO - CNH4CL + DSONIT = CNANO - CNANO3 + DSOCHL = CNACLO - CNACL +C +C *** FIND GAS DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. +C + DAMG = GNH3O - GNH3 + DHAG = GHCLO - GHCL + DNAG = GHNO3O - GHNO3 +C +C *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. +C +C LIQUID +C + MOLAL(1)= ONEMWF*MOLAL(1) ! H+ + MOLAL(2)= ONEMWF*(2.D0*DSOSUL + DSOBIS + DSONIT + DSOCHL) ! NA+ + MOLAL(3)= ONEMWF*(2.D0*DAMSUL + DAMG + DAMBIS + DAMCHL + + & 3.D0*DLC + DAMNIT ) ! NH4+ + MOLAL(4)= ONEMWF*( DAMCHL + DSOCHL + DHAG) ! CL- + MOLAL(5)= ONEMWF*( DAMSUL + DSOSUL + DLC - MOLAL(6)) ! SO4-- !VB 17 Sept 2001 + MOLAL(6)= ONEMWF*( MOLAL(6) + DSOBIS + DAMBIS + DLC) ! HSO4- + MOLAL(7)= ONEMWF*( DAMNIT + DSONIT + DNAG) ! NO3- + WATER = ONEMWF*WATER +C +C SOLID +C + CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 + CNA2SO4 = WF*CNA2SO + ONEMWF*CNA2SO4 + CNAHSO4 = WF*CNAHSO + ONEMWF*CNAHSO4 + CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 + CLC = WF*CLCO + ONEMWF*CLC + CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3 + CNANO3 = WF*CNANO + ONEMWF*CNANO3 + CNACL = WF*CNACLO + ONEMWF*CNACL + CNH4CL = WF*CNH4CLO + ONEMWF*CNH4CL +C +C GAS +C + GNH3 = WF*GNH3O + ONEMWF*GNH3 + GHNO3 = WF*GHNO3O + ONEMWF*GHNO3 + GHCL = WF*GHCLO + ONEMWF*GHCL +C +C *** RETURN POINT +C +200 RETURN +C +C *** END OF SUBROUTINE CALCMDRH **************************************** +C + END + + + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCMDRP +C +C THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL +C DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED +C SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE +C 'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCMDRP (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE) + INCLUDE 'isrpia.inc' + EXTERNAL DRYCASE, LIQCASE +C +C *** FIND WEIGHT FACTOR ********************************************** +C + IF (WFTYP.EQ.0) THEN + WF = ONE + ELSEIF (WFTYP.EQ.1) THEN + WF = 0.5D0 + ELSE + WF = (RHLIQ-RHI)/(RHLIQ-RHDRY) + ENDIF + ONEMWF = ONE - WF +C +C *** FIND FIRST SECTION ; DRY ONE ************************************ +C + CALL DRYCASE + IF (ABS(ONEMWF).LE.1D-5) GOTO 200 ! DRY AEROSOL +C + CNH42SO = CNH42S4 ! FIRST (DRY) SOLUTION + CNH4HSO = CNH4HS4 + CLCO = CLC + CNH4N3O = CNH4NO3 + CNH4CLO = CNH4CL + CNA2SO = CNA2SO4 + CNAHSO = CNAHSO4 + CNANO = CNANO3 + CNACLO = CNACL +C +C *** FIND SECOND SECTION ; DRY & LIQUID ****************************** +C + CNH42S4 = ZERO + CNH4HS4 = ZERO + CLC = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNA2SO4 = ZERO + CNAHSO4 = ZERO + CNANO3 = ZERO + CNACL = ZERO + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO + CALL LIQCASE ! SECOND (LIQUID) SOLUTION +C +C *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL +C + IF (WATER.LE.TINY) THEN + WATER = ZERO + DO 100 I=1,NIONS + MOLAL(I)= ZERO + 100 CONTINUE + CALL DRYCASE + GOTO 200 + ENDIF +C +C *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS. +C + DAMBIS = CNH4HSO - CNH4HS4 + DSOBIS = CNAHSO - CNAHSO4 + DLC = CLCO - CLC +C +C *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. +C +C *** SOLID +C + CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 + CNA2SO4 = WF*CNA2SO + ONEMWF*CNA2SO4 + CNAHSO4 = WF*CNAHSO + ONEMWF*CNAHSO4 + CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 + CLC = WF*CLCO + ONEMWF*CLC + CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3 + CNANO3 = WF*CNANO + ONEMWF*CNANO3 + CNACL = WF*CNACLO + ONEMWF*CNACL + CNH4CL = WF*CNH4CLO + ONEMWF*CNH4CL +C +C *** LIQUID +C + WATER = ONEMWF*WATER +C + MOLAL(2)= WAER(1) - 2.D0*CNA2SO4 - CNAHSO4 - CNANO3 - + & CNACL ! NA+ + MOLAL(3)= WAER(3) - 2.D0*CNH42S4 - CNH4HS4 - CNH4CL - + & 3.D0*CLC - CNH4NO3 ! NH4+ + MOLAL(4)= WAER(5) - CNACL - CNH4CL ! CL- + MOLAL(7)= WAER(4) - CNANO3 - CNH4NO3 ! NO3- + MOLAL(6)= ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC) ! HSO4- + MOLAL(5)= WAER(2) - MOLAL(6) - CLC - CNH42S4 - CNA2SO4 ! SO4-- +C + A8 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + IF (MOLAL(5).LE.TINY) THEN + HIEQ = SQRT(XKW *RH*WATER*WATER) ! Neutral solution + ELSE + HIEQ = A8*MOLAL(6)/MOLAL(5) + ENDIF + HIEN = MOLAL(4) + MOLAL(7) + MOLAL(6) + 2.D0*MOLAL(5) - + & MOLAL(2) - MOLAL(3) + MOLAL(1)= MAX (HIEQ, HIEN) ! H+ +C +C *** GAS (ACTIVITY COEFS FROM LIQUID SOLUTION) +C + A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = MOLAL(3)/MAX(MOLAL(1),TINY)/A2 + GHNO3 = MOLAL(1)*MOLAL(7)/A3 + GHCL = MOLAL(1)*MOLAL(4)/A4 +C +200 RETURN +C +C *** END OF SUBROUTINE CALCMDRP **************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCHS4 +C *** THIS SUBROUTINE CALCULATES THE HSO4 GENERATED FROM (H,SO4). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCHS4 (HI, SO4I, HSO4I, DELTA) + INCLUDE 'isrpia.inc' +CC CHARACTER ERRINF*40 +C +C *** IF TOO LITTLE WATER, DONT SOLVE +C + IF (WATER.LE.1d1*TINY) THEN + DELTA = ZERO + RETURN + ENDIF +C +C *** CALCULATE HSO4 SPECIATION ***************************************** +C + A8 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C + BB =-(HI + SO4I + A8) + CC = HI*SO4I - HSO4I*A8 + DD = BB*BB - 4.D0*CC +C + IF (DD.GE.ZERO) THEN + SQDD = SQRT(DD) + DELTA1 = 0.5*(-BB + SQDD) + DELTA2 = 0.5*(-BB - SQDD) + IF (HSO4I.LE.TINY) THEN + DELTA = DELTA2 + ELSEIF( HI*SO4I .GE. A8*HSO4I ) THEN + DELTA = DELTA2 + ELSEIF( HI*SO4I .LT. A8*HSO4I ) THEN + DELTA = DELTA1 + ELSE + DELTA = ZERO + ENDIF + ELSE + DELTA = ZERO + ENDIF +CCC +CCC *** COMPARE DELTA TO TOTAL H+ ; ESTIMATE EFFECT OF HSO4 *************** +CCC +CC HYD = MAX(HI, MOLAL(1)) +CC IF (HYD.GT.TINY) THEN +CC IF (DELTA/HYD.GT.0.1d0) THEN +CC WRITE (ERRINF,'(1PE10.3)') DELTA/HYD*100.0 +CC CALL PUSHERR (0020, ERRINF) +CC ENDIF +CC ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCHS4 ***************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCPH +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCPH (GG, HI, OHI) + INCLUDE 'isrpia.inc' +C + AKW = XKW *RH*WATER*WATER + CN = SQRT(AKW) +C +C *** GG = (negative charge) - (positive charge) +C + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = MAX(0.5D0*(-BB + SQRT(DD)),CN) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= MAX(0.5D0*(-BB + SQRT(DD)),CN) + HI = AKW/OHI + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCPH ****************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCACT +C *** CALCULATES MULTI-COMPONENET ACTIVITY COEFFICIENTS FROM BROMLEYS +C METHOD. THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY +C KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCACT + INCLUDE 'isrpia.inc' +C + REAL EX10, URF + REAL G0(3,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4) + DOUBLE PRECISION LN10 + DOUBLE PRECISION MPL, XIJ, YJI +C PARAMETER (URF=0.5) + PARAMETER (LN10=2.30258509299404568402D0) +C + G(I,J)= (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H +C +C *** SAVE ACTIVITIES IN OLD ARRAY ************************************* +C + IF (FRST) THEN ! Outer loop + DO 10 I=1,NPAIR + GAMOU(I) = GAMA(I) +10 CONTINUE + ENDIF +C + DO 20 I=1,NPAIR ! Inner loop + GAMIN(I) = GAMA(I) +20 CONTINUE +C +C *** CALCULATE IONIC ACTIVITY OF SOLUTION ***************************** +C + IONIC=0.0 + DO 30 I=1,NIONS + IONIC=IONIC + MOLAL(I)*Z(I)*Z(I) +30 CONTINUE + IONIC = MAX(MIN(0.5*IONIC/WATER,100.d0), TINY) +C +C *** CALCULATE BINARY ACTIVITY COEFFICIENTS *************************** +C +C G0(1,1)=G11;G0(1,2)=G07;G0(1,3)=G08;G0(1,4)=G10;G0(2,1)=G01;G0(2,2)=G02 +C G0(2,3)=G12;G0(2,4)=G03;G0(3,1)=G06;G0(3,2)=G04;G0(3,3)=G09;G0(3,4)=G05 +C + IF (IACALC.EQ.0) THEN ! K.M.; FULL + CALL KMFUL (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), + & G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), + & G0(1,4),G0(1,1),G0(2,3)) + ELSE ! K.M.; TABULATED + CALL KMTAB (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4), + & G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3), + & G0(1,4),G0(1,1),G0(2,3)) + ENDIF +C +C *** CALCULATE MULTICOMPONENT ACTIVITY COEFFICIENTS ******************* +C + AGAMA = 0.511*(298.0/TEMP)**1.5 ! Debye Huckel const. at T + SION = SQRT(IONIC) + H = AGAMA*SION/(1+SION) +C + DO 100 I=1,3 + F1(I)=0.0 + F2(I)=0.0 +100 CONTINUE + F2(4)=0.0 +C + DO 110 I=1,3 + ZPL = Z(I) + MPL = MOLAL(I)/WATER + DO 110 J=1,4 + ZMI = Z(J+3) + CH = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC + XIJ = CH*MPL + YJI = CH*MOLAL(J+3)/WATER + F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H)) + F2(J) = F2(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H)) +110 CONTINUE +C +C *** LOG10 OF ACTIVITY COEFFICIENTS *********************************** +C + GAMA(01) = G(2,1)*ZZ(01) ! NACL + GAMA(02) = G(2,2)*ZZ(02) ! NA2SO4 + GAMA(03) = G(2,4)*ZZ(03) ! NANO3 + GAMA(04) = G(3,2)*ZZ(04) ! (NH4)2SO4 + GAMA(05) = G(3,4)*ZZ(05) ! NH4NO3 + GAMA(06) = G(3,1)*ZZ(06) ! NH4CL + GAMA(07) = G(1,2)*ZZ(07) ! 2H-SO4 + GAMA(08) = G(1,3)*ZZ(08) ! H-HSO4 + GAMA(09) = G(3,3)*ZZ(09) ! NH4HSO4 + GAMA(10) = G(1,4)*ZZ(10) ! HNO3 + GAMA(11) = G(1,1)*ZZ(11) ! HCL + GAMA(12) = G(2,3)*ZZ(12) ! NAHSO4 + GAMA(13) = 0.20*(3.0*GAMA(04)+2.0*GAMA(09)) ! LC ; SCAPE +CC GAMA(13) = 0.50*(GAMA(04)+GAMA(09)) ! LC ; SEQUILIB +CC GAMA(13) = 0.25*(3.0*GAMA(04)+GAMA(07)) ! LC ; AIM +C +C *** CONVERT LOG (GAMA) COEFFICIENTS TO GAMA ************************** +C + DO 200 I=1,NPAIR + GAMA(I)=MAX(-5.0d0, MIN(GAMA(I),5.0d0) ) ! F77 LIBRARY ROUTINE +C GAMA(I)=10.0**GAMA(I) + GAMA(I)=EXP(LN10*GAMA(I)) +CC GAMA(I)=EX10(SNGL(GAMA(I)), 5.0) ! CUTOFF SET TO [-5,5] +C GAMA(I) = GAMIN(I)*(1.0-URF) + URF*GAMA(I) ! Under-relax GAMA's + 200 CONTINUE +C +C *** SETUP ACTIVITY CALCULATION FLAGS ********************************* +C +C OUTER CALCULATION LOOP ; ONLY IF FRST=.TRUE. +C + IF (FRST) THEN + ERROU = ZERO ! CONVERGENCE CRITERION + DO 210 I=1,NPAIR + ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I))) +210 CONTINUE + CALAOU = ERROU .GE. EPSACT ! SETUP FLAGS + FRST =.FALSE. + ENDIF +C +C INNER CALCULATION LOOP ; ALWAYS +C + ERRIN = ZERO ! CONVERGENCE CRITERION + DO 220 I=1,NPAIR + ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I))) +220 CONTINUE + CALAIN = ERRIN .GE. EPSACT +C + ICLACT = ICLACT + 1 ! Increment ACTIVITY call counter +C +C *** END OF SUBROUTINE ACTIVITY **************************************** +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE RSTGAM +C *** RESETS ACTIVITY COEFFICIENT ARRAYS TO DEFAULT VALUE OF 0.1 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE RSTGAM + INCLUDE 'isrpia.inc' +C + DO 10 I=1, NPAIR + GAMA(I) = 0.1 +10 CONTINUE +C +C *** END OF SUBROUTINE RSTGAM ****************************************** +C + RETURN + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KMFUL +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KMFUL (IONIC,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09, + & G10,G11,G12) + REAL Ionic, TEMP + DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11 + & /1, 2, 1, 2, 1, 1, 2, 1, 1, 1/ +C + SION = SQRT(IONIC) +C +C *** Coefficients at 25 oC +C + CALL MKBI(2.230, IONIC, SION, Z01, G01) + CALL MKBI(-0.19, IONIC, SION, Z02, G02) + CALL MKBI(-0.39, IONIC, SION, Z03, G03) + CALL MKBI(-0.25, IONIC, SION, Z04, G04) + CALL MKBI(-1.15, IONIC, SION, Z05, G05) + CALL MKBI(0.820, IONIC, SION, Z06, G06) + CALL MKBI(-.100, IONIC, SION, Z07, G07) + CALL MKBI(8.000, IONIC, SION, Z08, G08) + CALL MKBI(2.600, IONIC, SION, Z10, G10) + CALL MKBI(6.000, IONIC, SION, Z11, G11) +C +C *** Correct for T other than 298 K +C + TI = TEMP-273.0 + TC = TI-25.0 + IF (ABS(TC) .GT. 1.0) THEN + CF1 = 1.125-0.005*TI + CF2 = (0.125-0.005*TI)*(0.039*IONIC**0.92-0.41*SION/(1.+SION)) + G01 = CF1*G01 - CF2*Z01 + G02 = CF1*G02 - CF2*Z02 + G03 = CF1*G03 - CF2*Z03 + G04 = CF1*G04 - CF2*Z04 + G05 = CF1*G05 - CF2*Z05 + G06 = CF1*G06 - CF2*Z06 + G07 = CF1*G07 - CF2*Z07 + G08 = CF1*G08 - CF2*Z08 + G10 = CF1*G10 - CF2*Z10 + G11 = CF1*G11 - CF2*Z11 + ENDIF +C + G09 = G06 + G08 - G11 + G12 = G01 + G08 - G11 +C +C *** Return point ; End of subroutine +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE MKBI +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE MKBI(Q,IONIC,SION,ZIP,BI) +C + REAL IONIC +C + B=.75-.065*Q + C= 1.0 + IF (IONIC.LT.6.0) C=1.+.055*Q*EXP(-.023*IONIC*IONIC*IONIC) + XX=-0.5107*SION/(1.+C*SION) + BI=(1.+B*(1.+.1*IONIC)**Q-B) + BI=ZIP*ALOG10(BI) + ZIP*XX +C + RETURN + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KMTAB +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IONIC' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KMTAB (IN,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) + REAL IN, Temp +C +C *** Find temperature range +C + IND = NINT((TEMP-198.0)/25.0) + 1 + IND = MIN(MAX(IND,1),6) +C +C *** Call appropriate routine +C + IF (IND.EQ.1) THEN + CALL KM198 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12) + ELSEIF (IND.EQ.2) THEN + CALL KM223 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12) + ELSEIF (IND.EQ.3) THEN + CALL KM248 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12) + ELSEIF (IND.EQ.4) THEN + CALL KM273 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12) + ELSEIF (IND.EQ.5) THEN + CALL KM298 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12) + ELSE + CALL KM323 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12) + ENDIF +C +C *** Return point; End of subroutine +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KM198 +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C TEMPERATURE IS 198K +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KM198 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) +C +C *** Common block definition +C + COMMON /KMC198/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) + REAL IN +C +C *** Find position in arrays for binary activity coefficients +C + IF (IN.LE. 0.300000E+02) THEN + ipos = MIN(NINT( 0.200000E+02*IN) + 1, 600) + ELSE + ipos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) + ENDIF + ipos = min(ipos, 741) +C +C *** Assign values to return array +C + G01 = BNC01M(ipos) + G02 = BNC02M(ipos) + G03 = BNC03M(ipos) + G04 = BNC04M(ipos) + G05 = BNC05M(ipos) + G06 = BNC06M(ipos) + G07 = BNC07M(ipos) + G08 = BNC08M(ipos) + G09 = BNC09M(ipos) + G10 = BNC10M(ipos) + G11 = BNC11M(ipos) + G12 = BNC12M(ipos) +C +C *** Return point ; End of subroutine +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KM223 +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C TEMPERATURE IS 223K +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KM223 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) +C +C *** Common block definition +C + COMMON /KMC223/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) + REAL IN +C +C *** Find position in arrays for binary activity coefficients +C + IF (IN.LE. 0.300000E+02) THEN + ipos = MIN(NINT( 0.200000E+02*IN) + 1, 600) + ELSE + ipos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) + ENDIF + ipos = min(ipos, 741) +C +C *** Assign values to return array +C + G01 = BNC01M(ipos) + G02 = BNC02M(ipos) + G03 = BNC03M(ipos) + G04 = BNC04M(ipos) + G05 = BNC05M(ipos) + G06 = BNC06M(ipos) + G07 = BNC07M(ipos) + G08 = BNC08M(ipos) + G09 = BNC09M(ipos) + G10 = BNC10M(ipos) + G11 = BNC11M(ipos) + G12 = BNC12M(ipos) +C +C *** Return point ; End of subroutine +C + RETURN + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KM248 +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C TEMPERATURE IS 248K +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KM248 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) +C +C *** Common block definition +C + COMMON /KMC248/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) + REAL IN +C +C *** Find position in arrays for binary activity coefficients +C + IF (IN.LE. 0.300000E+02) THEN + ipos = MIN(NINT( 0.200000E+02*IN) + 1, 600) + ELSE + ipos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) + ENDIF + ipos = min(ipos, 741) + +C +C *** Assign values to return array +C + G01 = BNC01M(ipos) + G02 = BNC02M(ipos) + G03 = BNC03M(ipos) + G04 = BNC04M(ipos) + G05 = BNC05M(ipos) + G06 = BNC06M(ipos) + G07 = BNC07M(ipos) + G08 = BNC08M(ipos) + G09 = BNC09M(ipos) + G10 = BNC10M(ipos) + G11 = BNC11M(ipos) + G12 = BNC12M(ipos) +C +C *** Return point ; End of subroutine +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KM273 +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C TEMPERATURE IS 273K +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KM273 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) +C +C *** Common block definition +C + COMMON /KMC273/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) + REAL IN +C +C *** Find position in arrays for binary activity coefficients +C + IF (IN.LE. 0.300000E+02) THEN + ipos = MIN(NINT( 0.200000E+02*IN) + 1, 600) + ELSE + ipos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) + ENDIF + ipos = min(ipos, 741) + +C *** Assign values to return array +C + G01 = BNC01M(ipos) + G02 = BNC02M(ipos) + G03 = BNC03M(ipos) + G04 = BNC04M(ipos) + G05 = BNC05M(ipos) + G06 = BNC06M(ipos) + G07 = BNC07M(ipos) + G08 = BNC08M(ipos) + G09 = BNC09M(ipos) + G10 = BNC10M(ipos) + G11 = BNC11M(ipos) + G12 = BNC12M(ipos) +C +C *** Return point ; End of subroutine +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KM298 +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C TEMPERATURE IS 298K +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KM298 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) +C +C *** Common block definition +C + COMMON /KMC298/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) + REAL IN +C +C *** Find position in arrays for binary activity coefficients +C + IF (IN.LE. 0.300000E+02) THEN + ipos = MIN(NINT( 0.200000E+02*IN) + 1, 600) + ELSE + ipos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) + ENDIF + ipos = min(ipos, 741) + +C *** Assign values to return array +C + G01 = BNC01M(ipos) + G02 = BNC02M(ipos) + G03 = BNC03M(ipos) + G04 = BNC04M(ipos) + G05 = BNC05M(ipos) + G06 = BNC06M(ipos) + G07 = BNC07M(ipos) + G08 = BNC08M(ipos) + G09 = BNC09M(ipos) + G10 = BNC10M(ipos) + G11 = BNC11M(ipos) + G12 = BNC12M(ipos) +C +C *** Return point ; End of subroutine +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE KM323 +C *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD. +C THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN +C LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY +C 'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS. +C +C TEMPERATURE IS 323K +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE KM323 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, + & G11,G12) +C +C *** Common block definition +C + COMMON /KMC323/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) + REAL IN +C +C *** Find position in arrays for binary activity coefficients +C + IF (IN.LE. 0.300000E+02) THEN + ipos = MIN(NINT( 0.200000E+02*IN) + 1, 600) + ELSE + ipos = 600+NINT( 0.200000E+01*IN- 0.600000E+02) + ENDIF + ipos = min(ipos, 741) + +C *** Assign values to return array +C + G01 = BNC01M(ipos) + G02 = BNC02M(ipos) + G03 = BNC03M(ipos) + G04 = BNC04M(ipos) + G05 = BNC05M(ipos) + G06 = BNC06M(ipos) + G07 = BNC07M(ipos) + G08 = BNC08M(ipos) + G09 = BNC09M(ipos) + G10 = BNC10M(ipos) + G11 = BNC11M(ipos) + G12 = BNC12M(ipos) +C +C *** Return point ; End of subroutine +C + RETURN + END + + +C *** TEMP = 198.0 + + BLOCK DATA KMCF198 +C +C *** Common block definition +C + COMMON /KMC198/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) +C +C *** NaCl +C + DATA (BNC01M (I),I= 1,100)/ + &-0.54728E-01,-0.96305E-01,-0.12309E+00,-0.13978E+00,-0.15161E+00, + &-0.16050E+00,-0.16740E+00,-0.17287E+00,-0.17725E+00,-0.18077E+00, + &-0.18360E+00,-0.18587E+00,-0.18765E+00,-0.18904E+00,-0.19007E+00, + &-0.19081E+00,-0.19129E+00,-0.19153E+00,-0.19157E+00,-0.19143E+00, + &-0.19114E+00,-0.19069E+00,-0.19012E+00,-0.18943E+00,-0.18863E+00, + &-0.18775E+00,-0.18677E+00,-0.18572E+00,-0.18460E+00,-0.18341E+00, + &-0.18217E+00,-0.18087E+00,-0.17953E+00,-0.17814E+00,-0.17672E+00, + &-0.17526E+00,-0.17377E+00,-0.17225E+00,-0.17071E+00,-0.16914E+00, + &-0.16756E+00,-0.16596E+00,-0.16434E+00,-0.16271E+00,-0.16106E+00, + &-0.15941E+00,-0.15775E+00,-0.15607E+00,-0.15440E+00,-0.15271E+00, + &-0.15102E+00,-0.14933E+00,-0.14763E+00,-0.14592E+00,-0.14422E+00, + &-0.14251E+00,-0.14080E+00,-0.13908E+00,-0.13736E+00,-0.13564E+00, + &-0.13392E+00,-0.13219E+00,-0.13046E+00,-0.12872E+00,-0.12698E+00, + &-0.12523E+00,-0.12347E+00,-0.12171E+00,-0.11995E+00,-0.11817E+00, + &-0.11638E+00,-0.11459E+00,-0.11279E+00,-0.11097E+00,-0.10915E+00, + &-0.10731E+00,-0.10546E+00,-0.10360E+00,-0.10172E+00,-0.99830E-01, + &-0.97925E-01,-0.96004E-01,-0.94068E-01,-0.92116E-01,-0.90147E-01, + &-0.88163E-01,-0.86161E-01,-0.84143E-01,-0.82108E-01,-0.80055E-01, + &-0.77986E-01,-0.75900E-01,-0.73797E-01,-0.71678E-01,-0.69542E-01, + &-0.67390E-01,-0.65222E-01,-0.63039E-01,-0.60840E-01,-0.58627E-01/ + + DATA (BNC01M (I),I=101,200)/ + &-0.56400E-01,-0.54159E-01,-0.51905E-01,-0.49639E-01,-0.47360E-01, + &-0.45070E-01,-0.42769E-01,-0.40457E-01,-0.38136E-01,-0.35805E-01, + &-0.33466E-01,-0.31119E-01,-0.28765E-01,-0.26404E-01,-0.24036E-01, + &-0.21663E-01,-0.19285E-01,-0.16902E-01,-0.14514E-01,-0.12123E-01, + &-0.10058E-01,-0.76233E-02,-0.51896E-02,-0.27575E-02,-0.32700E-03, + & 0.21018E-02, 0.45288E-02, 0.69540E-02, 0.93773E-02, 0.11799E-01, + & 0.14218E-01, 0.16635E-01, 0.19050E-01, 0.21463E-01, 0.23873E-01, + & 0.26281E-01, 0.28687E-01, 0.31090E-01, 0.33491E-01, 0.35889E-01, + & 0.38285E-01, 0.40678E-01, 0.43068E-01, 0.45456E-01, 0.47840E-01, + & 0.50222E-01, 0.52601E-01, 0.54977E-01, 0.57350E-01, 0.59721E-01, + & 0.62088E-01, 0.64452E-01, 0.66813E-01, 0.69171E-01, 0.71526E-01, + & 0.73877E-01, 0.76225E-01, 0.78571E-01, 0.80912E-01, 0.83251E-01, + & 0.85586E-01, 0.87918E-01, 0.90247E-01, 0.92572E-01, 0.94893E-01, + & 0.97212E-01, 0.99526E-01, 0.10184E+00, 0.10415E+00, 0.10645E+00, + & 0.10875E+00, 0.11105E+00, 0.11334E+00, 0.11563E+00, 0.11792E+00, + & 0.12020E+00, 0.12248E+00, 0.12475E+00, 0.12703E+00, 0.12929E+00, + & 0.13156E+00, 0.13382E+00, 0.13608E+00, 0.13833E+00, 0.14058E+00, + & 0.14282E+00, 0.14507E+00, 0.14730E+00, 0.14954E+00, 0.15177E+00, + & 0.15399E+00, 0.15622E+00, 0.15844E+00, 0.16065E+00, 0.16286E+00, + & 0.16507E+00, 0.16727E+00, 0.16947E+00, 0.17167E+00, 0.17386E+00/ + + DATA (BNC01M (I),I=201,300)/ + & 0.17605E+00, 0.17823E+00, 0.18041E+00, 0.18259E+00, 0.18476E+00, + & 0.18693E+00, 0.18909E+00, 0.19126E+00, 0.19341E+00, 0.19557E+00, + & 0.19771E+00, 0.19986E+00, 0.20200E+00, 0.20414E+00, 0.20627E+00, + & 0.20840E+00, 0.21053E+00, 0.21265E+00, 0.21476E+00, 0.21688E+00, + & 0.21899E+00, 0.22109E+00, 0.22320E+00, 0.22529E+00, 0.22739E+00, + & 0.22948E+00, 0.23156E+00, 0.23364E+00, 0.23572E+00, 0.23780E+00, + & 0.23987E+00, 0.24193E+00, 0.24400E+00, 0.24606E+00, 0.24811E+00, + & 0.25016E+00, 0.25221E+00, 0.25425E+00, 0.25629E+00, 0.25832E+00, + & 0.26036E+00, 0.26238E+00, 0.26441E+00, 0.26643E+00, 0.26844E+00, + & 0.27045E+00, 0.27246E+00, 0.27447E+00, 0.27647E+00, 0.27846E+00, + & 0.28045E+00, 0.28244E+00, 0.28443E+00, 0.28641E+00, 0.28839E+00, + & 0.29036E+00, 0.29233E+00, 0.29429E+00, 0.29626E+00, 0.29821E+00, + & 0.30017E+00, 0.30212E+00, 0.30406E+00, 0.30601E+00, 0.30794E+00, + & 0.30988E+00, 0.31181E+00, 0.31374E+00, 0.31566E+00, 0.31758E+00, + & 0.31950E+00, 0.32141E+00, 0.32332E+00, 0.32522E+00, 0.32712E+00, + & 0.32902E+00, 0.33092E+00, 0.33281E+00, 0.33469E+00, 0.33657E+00, + & 0.33845E+00, 0.34033E+00, 0.34220E+00, 0.34407E+00, 0.34593E+00, + & 0.34779E+00, 0.34965E+00, 0.35150E+00, 0.35335E+00, 0.35519E+00, + & 0.35704E+00, 0.35887E+00, 0.36071E+00, 0.36254E+00, 0.36437E+00, + & 0.36619E+00, 0.36801E+00, 0.36983E+00, 0.37164E+00, 0.37345E+00/ + + DATA (BNC01M (I),I=301,400)/ + & 0.37526E+00, 0.37706E+00, 0.37886E+00, 0.38065E+00, 0.38244E+00, + & 0.38423E+00, 0.38602E+00, 0.38780E+00, 0.38957E+00, 0.39135E+00, + & 0.39312E+00, 0.39489E+00, 0.39665E+00, 0.39841E+00, 0.40017E+00, + & 0.40192E+00, 0.40367E+00, 0.40541E+00, 0.40716E+00, 0.40890E+00, + & 0.41063E+00, 0.41236E+00, 0.41409E+00, 0.41582E+00, 0.41754E+00, + & 0.41926E+00, 0.42097E+00, 0.42268E+00, 0.42439E+00, 0.42610E+00, + & 0.42780E+00, 0.42950E+00, 0.43119E+00, 0.43288E+00, 0.43457E+00, + & 0.43626E+00, 0.43794E+00, 0.43962E+00, 0.44129E+00, 0.44296E+00, + & 0.44463E+00, 0.44630E+00, 0.44796E+00, 0.44962E+00, 0.45127E+00, + & 0.45292E+00, 0.45457E+00, 0.45622E+00, 0.45786E+00, 0.45950E+00, + & 0.46113E+00, 0.46277E+00, 0.46439E+00, 0.46602E+00, 0.46764E+00, + & 0.46926E+00, 0.47088E+00, 0.47249E+00, 0.47410E+00, 0.47571E+00, + & 0.47731E+00, 0.47891E+00, 0.48051E+00, 0.48211E+00, 0.48370E+00, + & 0.48528E+00, 0.48687E+00, 0.48845E+00, 0.49003E+00, 0.49161E+00, + & 0.49318E+00, 0.49475E+00, 0.49631E+00, 0.49788E+00, 0.49944E+00, + & 0.50099E+00, 0.50255E+00, 0.50410E+00, 0.50565E+00, 0.50719E+00, + & 0.50873E+00, 0.51027E+00, 0.51181E+00, 0.51334E+00, 0.51487E+00, + & 0.51640E+00, 0.51792E+00, 0.51944E+00, 0.52096E+00, 0.52248E+00, + & 0.52399E+00, 0.52550E+00, 0.52700E+00, 0.52851E+00, 0.53001E+00, + & 0.53150E+00, 0.53300E+00, 0.53449E+00, 0.53598E+00, 0.53747E+00/ + + DATA (BNC01M (I),I=401,500)/ + & 0.53895E+00, 0.54043E+00, 0.54191E+00, 0.54338E+00, 0.54485E+00, + & 0.54632E+00, 0.54779E+00, 0.54925E+00, 0.55071E+00, 0.55217E+00, + & 0.55362E+00, 0.55507E+00, 0.55652E+00, 0.55797E+00, 0.55941E+00, + & 0.56085E+00, 0.56229E+00, 0.56372E+00, 0.56515E+00, 0.56658E+00, + & 0.56801E+00, 0.56943E+00, 0.57086E+00, 0.57227E+00, 0.57369E+00, + & 0.57510E+00, 0.57651E+00, 0.57792E+00, 0.57932E+00, 0.58073E+00, + & 0.58213E+00, 0.58352E+00, 0.58492E+00, 0.58631E+00, 0.58770E+00, + & 0.58908E+00, 0.59047E+00, 0.59185E+00, 0.59323E+00, 0.59460E+00, + & 0.59597E+00, 0.59734E+00, 0.59871E+00, 0.60008E+00, 0.60144E+00, + & 0.60280E+00, 0.60415E+00, 0.60551E+00, 0.60686E+00, 0.60821E+00, + & 0.60956E+00, 0.61090E+00, 0.61224E+00, 0.61358E+00, 0.61492E+00, + & 0.61625E+00, 0.61758E+00, 0.61891E+00, 0.62024E+00, 0.62156E+00, + & 0.62288E+00, 0.62420E+00, 0.62552E+00, 0.62683E+00, 0.62815E+00, + & 0.62945E+00, 0.63076E+00, 0.63206E+00, 0.63337E+00, 0.63467E+00, + & 0.63596E+00, 0.63726E+00, 0.63855E+00, 0.63984E+00, 0.64112E+00, + & 0.64241E+00, 0.64369E+00, 0.64497E+00, 0.64625E+00, 0.64752E+00, + & 0.64879E+00, 0.65006E+00, 0.65133E+00, 0.65260E+00, 0.65386E+00, + & 0.65512E+00, 0.65638E+00, 0.65763E+00, 0.65889E+00, 0.66014E+00, + & 0.66139E+00, 0.66263E+00, 0.66388E+00, 0.66512E+00, 0.66636E+00, + & 0.66759E+00, 0.66883E+00, 0.67006E+00, 0.67129E+00, 0.67252E+00/ + + DATA (BNC01M (I),I=501,600)/ + & 0.67374E+00, 0.67497E+00, 0.67619E+00, 0.67741E+00, 0.67862E+00, + & 0.67984E+00, 0.68105E+00, 0.68226E+00, 0.68347E+00, 0.68467E+00, + & 0.68587E+00, 0.68707E+00, 0.68827E+00, 0.68947E+00, 0.69066E+00, + & 0.69185E+00, 0.69304E+00, 0.69423E+00, 0.69542E+00, 0.69660E+00, + & 0.69778E+00, 0.69896E+00, 0.70013E+00, 0.70131E+00, 0.70248E+00, + & 0.70365E+00, 0.70482E+00, 0.70598E+00, 0.70715E+00, 0.70831E+00, + & 0.70947E+00, 0.71062E+00, 0.71178E+00, 0.71293E+00, 0.71408E+00, + & 0.71523E+00, 0.71638E+00, 0.71752E+00, 0.71866E+00, 0.71980E+00, + & 0.72094E+00, 0.72208E+00, 0.72321E+00, 0.72434E+00, 0.72547E+00, + & 0.72660E+00, 0.72772E+00, 0.72885E+00, 0.72997E+00, 0.73109E+00, + & 0.73220E+00, 0.73332E+00, 0.73443E+00, 0.73554E+00, 0.73665E+00, + & 0.73776E+00, 0.73886E+00, 0.73997E+00, 0.74107E+00, 0.74217E+00, + & 0.74326E+00, 0.74436E+00, 0.74545E+00, 0.74654E+00, 0.74763E+00, + & 0.74872E+00, 0.74980E+00, 0.75089E+00, 0.75197E+00, 0.75305E+00, + & 0.75412E+00, 0.75520E+00, 0.75627E+00, 0.75734E+00, 0.75841E+00, + & 0.75948E+00, 0.76055E+00, 0.76161E+00, 0.76267E+00, 0.76373E+00, + & 0.76479E+00, 0.76584E+00, 0.76690E+00, 0.76795E+00, 0.76900E+00, + & 0.77005E+00, 0.77109E+00, 0.77214E+00, 0.77318E+00, 0.77422E+00, + & 0.77526E+00, 0.77630E+00, 0.77733E+00, 0.77836E+00, 0.77940E+00, + & 0.78043E+00, 0.78145E+00, 0.78248E+00, 0.78350E+00, 0.78733E+00/ + + DATA (BNC01M (I),I=601,700)/ + & 0.79565E+00, 0.80557E+00, 0.81531E+00, 0.82489E+00, 0.83429E+00, + & 0.84353E+00, 0.85261E+00, 0.86153E+00, 0.87029E+00, 0.87890E+00, + & 0.88737E+00, 0.89568E+00, 0.90385E+00, 0.91188E+00, 0.91978E+00, + & 0.92754E+00, 0.93516E+00, 0.94265E+00, 0.95002E+00, 0.95726E+00, + & 0.96438E+00, 0.97138E+00, 0.97825E+00, 0.98501E+00, 0.99166E+00, + & 0.99819E+00, 0.10046E+01, 0.10109E+01, 0.10171E+01, 0.10232E+01, + & 0.10292E+01, 0.10351E+01, 0.10409E+01, 0.10466E+01, 0.10522E+01, + & 0.10577E+01, 0.10632E+01, 0.10685E+01, 0.10737E+01, 0.10788E+01, + & 0.10839E+01, 0.10889E+01, 0.10938E+01, 0.10986E+01, 0.11033E+01, + & 0.11079E+01, 0.11125E+01, 0.11169E+01, 0.11213E+01, 0.11257E+01, + & 0.11299E+01, 0.11341E+01, 0.11382E+01, 0.11422E+01, 0.11462E+01, + & 0.11501E+01, 0.11539E+01, 0.11577E+01, 0.11613E+01, 0.11650E+01, + & 0.11685E+01, 0.11720E+01, 0.11754E+01, 0.11788E+01, 0.11821E+01, + & 0.11853E+01, 0.11885E+01, 0.11916E+01, 0.11947E+01, 0.11977E+01, + & 0.12007E+01, 0.12036E+01, 0.12064E+01, 0.12092E+01, 0.12119E+01, + & 0.12146E+01, 0.12172E+01, 0.12198E+01, 0.12223E+01, 0.12248E+01, + & 0.12272E+01, 0.12296E+01, 0.12319E+01, 0.12342E+01, 0.12364E+01, + & 0.12386E+01, 0.12407E+01, 0.12428E+01, 0.12449E+01, 0.12469E+01, + & 0.12488E+01, 0.12507E+01, 0.12526E+01, 0.12544E+01, 0.12562E+01, + & 0.12579E+01, 0.12596E+01, 0.12613E+01, 0.12629E+01, 0.12645E+01/ + + DATA (BNC01M(I),I=701,741)/ + & 0.12660E+01, 0.12675E+01, 0.12690E+01, 0.12704E+01, 0.12718E+01, + & 0.12731E+01, 0.12744E+01, 0.12757E+01, 0.12769E+01, 0.12781E+01, + & 0.12793E+01, 0.12804E+01, 0.12815E+01, 0.12825E+01, 0.12836E+01, + & 0.12846E+01, 0.12855E+01, 0.12864E+01, 0.12873E+01, 0.12882E+01, + & 0.12890E+01, 0.12898E+01, 0.12906E+01, 0.12913E+01, 0.12920E+01, + & 0.12927E+01, 0.12933E+01, 0.12939E+01, 0.12945E+01, 0.12951E+01, + & 0.12956E+01, 0.12961E+01, 0.12966E+01, 0.12970E+01, 0.12974E+01, + & 0.12978E+01, 0.12981E+01, 0.12985E+01, 0.12988E+01, 0.12991E+01, + & 0.12993E+01 + & / +C +C *** Na2SO4 +C + DATA (BNC02M (I),I= 1,100)/ + &-0.11393E+00,-0.20901E+00,-0.27708E+00,-0.32413E+00,-0.36089E+00, + &-0.39137E+00,-0.41757E+00,-0.44064E+00,-0.46132E+00,-0.48011E+00, + &-0.49735E+00,-0.51331E+00,-0.52819E+00,-0.54215E+00,-0.55531E+00, + &-0.56776E+00,-0.57959E+00,-0.59087E+00,-0.60165E+00,-0.61199E+00, + &-0.62193E+00,-0.63150E+00,-0.64073E+00,-0.64965E+00,-0.65829E+00, + &-0.66666E+00,-0.67479E+00,-0.68269E+00,-0.69038E+00,-0.69786E+00, + &-0.70517E+00,-0.71229E+00,-0.71925E+00,-0.72606E+00,-0.73272E+00, + &-0.73923E+00,-0.74562E+00,-0.75188E+00,-0.75802E+00,-0.76405E+00, + &-0.76996E+00,-0.77578E+00,-0.78149E+00,-0.78711E+00,-0.79264E+00, + &-0.79808E+00,-0.80343E+00,-0.80871E+00,-0.81391E+00,-0.81903E+00, + &-0.82409E+00,-0.82907E+00,-0.83399E+00,-0.83885E+00,-0.84364E+00, + &-0.84837E+00,-0.85305E+00,-0.85767E+00,-0.86224E+00,-0.86676E+00, + &-0.87123E+00,-0.87565E+00,-0.88002E+00,-0.88435E+00,-0.88863E+00, + &-0.89288E+00,-0.89708E+00,-0.90124E+00,-0.90537E+00,-0.90946E+00, + &-0.91351E+00,-0.91753E+00,-0.92152E+00,-0.92547E+00,-0.92939E+00, + &-0.93329E+00,-0.93715E+00,-0.94099E+00,-0.94480E+00,-0.94858E+00, + &-0.95234E+00,-0.95607E+00,-0.95978E+00,-0.96346E+00,-0.96712E+00, + &-0.97076E+00,-0.97438E+00,-0.97797E+00,-0.98155E+00,-0.98511E+00, + &-0.98864E+00,-0.99216E+00,-0.99566E+00,-0.99914E+00,-0.10026E+01, + &-0.10061E+01,-0.10095E+01,-0.10129E+01,-0.10163E+01,-0.10197E+01/ + + DATA (BNC02M (I),I=101,200)/ + &-0.10230E+01,-0.10264E+01,-0.10297E+01,-0.10330E+01,-0.10363E+01, + &-0.10396E+01,-0.10429E+01,-0.10462E+01,-0.10494E+01,-0.10526E+01, + &-0.10559E+01,-0.10591E+01,-0.10623E+01,-0.10654E+01,-0.10686E+01, + &-0.10718E+01,-0.10749E+01,-0.10780E+01,-0.10812E+01,-0.10843E+01, + &-0.10873E+01,-0.10904E+01,-0.10935E+01,-0.10965E+01,-0.10996E+01, + &-0.11026E+01,-0.11056E+01,-0.11087E+01,-0.11117E+01,-0.11147E+01, + &-0.11176E+01,-0.11206E+01,-0.11236E+01,-0.11265E+01,-0.11295E+01, + &-0.11324E+01,-0.11353E+01,-0.11382E+01,-0.11411E+01,-0.11440E+01, + &-0.11469E+01,-0.11497E+01,-0.11526E+01,-0.11555E+01,-0.11583E+01, + &-0.11611E+01,-0.11640E+01,-0.11668E+01,-0.11696E+01,-0.11724E+01, + &-0.11752E+01,-0.11779E+01,-0.11807E+01,-0.11835E+01,-0.11862E+01, + &-0.11890E+01,-0.11917E+01,-0.11945E+01,-0.11972E+01,-0.11999E+01, + &-0.12026E+01,-0.12053E+01,-0.12080E+01,-0.12107E+01,-0.12134E+01, + &-0.12160E+01,-0.12187E+01,-0.12214E+01,-0.12240E+01,-0.12267E+01, + &-0.12293E+01,-0.12319E+01,-0.12346E+01,-0.12372E+01,-0.12398E+01, + &-0.12424E+01,-0.12450E+01,-0.12476E+01,-0.12502E+01,-0.12528E+01, + &-0.12553E+01,-0.12579E+01,-0.12605E+01,-0.12630E+01,-0.12656E+01, + &-0.12681E+01,-0.12707E+01,-0.12732E+01,-0.12757E+01,-0.12782E+01, + &-0.12807E+01,-0.12833E+01,-0.12858E+01,-0.12883E+01,-0.12908E+01, + &-0.12932E+01,-0.12957E+01,-0.12982E+01,-0.13007E+01,-0.13032E+01/ + + DATA (BNC02M (I),I=201,300)/ + &-0.13056E+01,-0.13081E+01,-0.13105E+01,-0.13130E+01,-0.13154E+01, + &-0.13179E+01,-0.13203E+01,-0.13227E+01,-0.13251E+01,-0.13276E+01, + &-0.13300E+01,-0.13324E+01,-0.13348E+01,-0.13372E+01,-0.13396E+01, + &-0.13420E+01,-0.13444E+01,-0.13468E+01,-0.13491E+01,-0.13515E+01, + &-0.13539E+01,-0.13562E+01,-0.13586E+01,-0.13610E+01,-0.13633E+01, + &-0.13657E+01,-0.13680E+01,-0.13704E+01,-0.13727E+01,-0.13750E+01, + &-0.13774E+01,-0.13797E+01,-0.13820E+01,-0.13843E+01,-0.13866E+01, + &-0.13890E+01,-0.13913E+01,-0.13936E+01,-0.13959E+01,-0.13982E+01, + &-0.14004E+01,-0.14027E+01,-0.14050E+01,-0.14073E+01,-0.14096E+01, + &-0.14119E+01,-0.14141E+01,-0.14164E+01,-0.14187E+01,-0.14209E+01, + &-0.14232E+01,-0.14254E+01,-0.14277E+01,-0.14299E+01,-0.14322E+01, + &-0.14344E+01,-0.14366E+01,-0.14389E+01,-0.14411E+01,-0.14433E+01, + &-0.14456E+01,-0.14478E+01,-0.14500E+01,-0.14522E+01,-0.14544E+01, + &-0.14566E+01,-0.14588E+01,-0.14610E+01,-0.14632E+01,-0.14654E+01, + &-0.14676E+01,-0.14698E+01,-0.14720E+01,-0.14742E+01,-0.14764E+01, + &-0.14785E+01,-0.14807E+01,-0.14829E+01,-0.14851E+01,-0.14872E+01, + &-0.14894E+01,-0.14916E+01,-0.14937E+01,-0.14959E+01,-0.14980E+01, + &-0.15002E+01,-0.15023E+01,-0.15045E+01,-0.15066E+01,-0.15087E+01, + &-0.15109E+01,-0.15130E+01,-0.15152E+01,-0.15173E+01,-0.15194E+01, + &-0.15215E+01,-0.15237E+01,-0.15258E+01,-0.15279E+01,-0.15300E+01/ + + DATA (BNC02M (I),I=301,400)/ + &-0.15321E+01,-0.15342E+01,-0.15363E+01,-0.15384E+01,-0.15405E+01, + &-0.15426E+01,-0.15447E+01,-0.15468E+01,-0.15489E+01,-0.15510E+01, + &-0.15531E+01,-0.15552E+01,-0.15573E+01,-0.15594E+01,-0.15614E+01, + &-0.15635E+01,-0.15656E+01,-0.15677E+01,-0.15697E+01,-0.15718E+01, + &-0.15739E+01,-0.15759E+01,-0.15780E+01,-0.15800E+01,-0.15821E+01, + &-0.15842E+01,-0.15862E+01,-0.15883E+01,-0.15903E+01,-0.15923E+01, + &-0.15944E+01,-0.15964E+01,-0.15985E+01,-0.16005E+01,-0.16025E+01, + &-0.16046E+01,-0.16066E+01,-0.16086E+01,-0.16107E+01,-0.16127E+01, + &-0.16147E+01,-0.16167E+01,-0.16188E+01,-0.16208E+01,-0.16228E+01, + &-0.16248E+01,-0.16268E+01,-0.16288E+01,-0.16308E+01,-0.16328E+01, + &-0.16348E+01,-0.16368E+01,-0.16388E+01,-0.16408E+01,-0.16428E+01, + &-0.16448E+01,-0.16468E+01,-0.16488E+01,-0.16508E+01,-0.16528E+01, + &-0.16548E+01,-0.16568E+01,-0.16587E+01,-0.16607E+01,-0.16627E+01, + &-0.16647E+01,-0.16667E+01,-0.16686E+01,-0.16706E+01,-0.16726E+01, + &-0.16745E+01,-0.16765E+01,-0.16785E+01,-0.16804E+01,-0.16824E+01, + &-0.16844E+01,-0.16863E+01,-0.16883E+01,-0.16902E+01,-0.16922E+01, + &-0.16941E+01,-0.16961E+01,-0.16980E+01,-0.17000E+01,-0.17019E+01, + &-0.17039E+01,-0.17058E+01,-0.17077E+01,-0.17097E+01,-0.17116E+01, + &-0.17136E+01,-0.17155E+01,-0.17174E+01,-0.17194E+01,-0.17213E+01, + &-0.17232E+01,-0.17251E+01,-0.17271E+01,-0.17290E+01,-0.17309E+01/ + + DATA (BNC02M (I),I=401,500)/ + &-0.17328E+01,-0.17347E+01,-0.17367E+01,-0.17386E+01,-0.17405E+01, + &-0.17424E+01,-0.17443E+01,-0.17462E+01,-0.17481E+01,-0.17500E+01, + &-0.17519E+01,-0.17538E+01,-0.17557E+01,-0.17576E+01,-0.17595E+01, + &-0.17614E+01,-0.17633E+01,-0.17652E+01,-0.17671E+01,-0.17690E+01, + &-0.17709E+01,-0.17728E+01,-0.17747E+01,-0.17766E+01,-0.17785E+01, + &-0.17804E+01,-0.17822E+01,-0.17841E+01,-0.17860E+01,-0.17879E+01, + &-0.17898E+01,-0.17916E+01,-0.17935E+01,-0.17954E+01,-0.17973E+01, + &-0.17991E+01,-0.18010E+01,-0.18029E+01,-0.18047E+01,-0.18066E+01, + &-0.18085E+01,-0.18103E+01,-0.18122E+01,-0.18140E+01,-0.18159E+01, + &-0.18178E+01,-0.18196E+01,-0.18215E+01,-0.18233E+01,-0.18252E+01, + &-0.18270E+01,-0.18289E+01,-0.18307E+01,-0.18326E+01,-0.18344E+01, + &-0.18363E+01,-0.18381E+01,-0.18400E+01,-0.18418E+01,-0.18437E+01, + &-0.18455E+01,-0.18473E+01,-0.18492E+01,-0.18510E+01,-0.18528E+01, + &-0.18547E+01,-0.18565E+01,-0.18583E+01,-0.18602E+01,-0.18620E+01, + &-0.18638E+01,-0.18657E+01,-0.18675E+01,-0.18693E+01,-0.18711E+01, + &-0.18730E+01,-0.18748E+01,-0.18766E+01,-0.18784E+01,-0.18802E+01, + &-0.18821E+01,-0.18839E+01,-0.18857E+01,-0.18875E+01,-0.18893E+01, + &-0.18911E+01,-0.18929E+01,-0.18948E+01,-0.18966E+01,-0.18984E+01, + &-0.19002E+01,-0.19020E+01,-0.19038E+01,-0.19056E+01,-0.19074E+01, + &-0.19092E+01,-0.19110E+01,-0.19128E+01,-0.19146E+01,-0.19164E+01/ + + DATA (BNC02M (I),I=501,600)/ + &-0.19182E+01,-0.19200E+01,-0.19218E+01,-0.19236E+01,-0.19254E+01, + &-0.19272E+01,-0.19289E+01,-0.19307E+01,-0.19325E+01,-0.19343E+01, + &-0.19361E+01,-0.19379E+01,-0.19397E+01,-0.19415E+01,-0.19432E+01, + &-0.19450E+01,-0.19468E+01,-0.19486E+01,-0.19504E+01,-0.19521E+01, + &-0.19539E+01,-0.19557E+01,-0.19575E+01,-0.19592E+01,-0.19610E+01, + &-0.19628E+01,-0.19646E+01,-0.19663E+01,-0.19681E+01,-0.19699E+01, + &-0.19716E+01,-0.19734E+01,-0.19752E+01,-0.19769E+01,-0.19787E+01, + &-0.19804E+01,-0.19822E+01,-0.19840E+01,-0.19857E+01,-0.19875E+01, + &-0.19892E+01,-0.19910E+01,-0.19928E+01,-0.19945E+01,-0.19963E+01, + &-0.19980E+01,-0.19998E+01,-0.20015E+01,-0.20033E+01,-0.20050E+01, + &-0.20068E+01,-0.20085E+01,-0.20103E+01,-0.20120E+01,-0.20138E+01, + &-0.20155E+01,-0.20173E+01,-0.20190E+01,-0.20207E+01,-0.20225E+01, + &-0.20242E+01,-0.20260E+01,-0.20277E+01,-0.20294E+01,-0.20312E+01, + &-0.20329E+01,-0.20347E+01,-0.20364E+01,-0.20381E+01,-0.20399E+01, + &-0.20416E+01,-0.20433E+01,-0.20451E+01,-0.20468E+01,-0.20485E+01, + &-0.20502E+01,-0.20520E+01,-0.20537E+01,-0.20554E+01,-0.20572E+01, + &-0.20589E+01,-0.20606E+01,-0.20623E+01,-0.20640E+01,-0.20658E+01, + &-0.20675E+01,-0.20692E+01,-0.20709E+01,-0.20726E+01,-0.20744E+01, + &-0.20761E+01,-0.20778E+01,-0.20795E+01,-0.20812E+01,-0.20829E+01, + &-0.20847E+01,-0.20864E+01,-0.20881E+01,-0.20898E+01,-0.20962E+01/ + + DATA (BNC02M (I),I=601,700)/ + &-0.21103E+01,-0.21272E+01,-0.21441E+01,-0.21610E+01,-0.21778E+01, + &-0.21945E+01,-0.22111E+01,-0.22277E+01,-0.22442E+01,-0.22607E+01, + &-0.22771E+01,-0.22934E+01,-0.23097E+01,-0.23260E+01,-0.23422E+01, + &-0.23583E+01,-0.23744E+01,-0.23904E+01,-0.24064E+01,-0.24224E+01, + &-0.24383E+01,-0.24541E+01,-0.24699E+01,-0.24857E+01,-0.25014E+01, + &-0.25171E+01,-0.25327E+01,-0.25483E+01,-0.25639E+01,-0.25794E+01, + &-0.25949E+01,-0.26104E+01,-0.26258E+01,-0.26412E+01,-0.26565E+01, + &-0.26718E+01,-0.26871E+01,-0.27023E+01,-0.27175E+01,-0.27327E+01, + &-0.27479E+01,-0.27630E+01,-0.27781E+01,-0.27931E+01,-0.28082E+01, + &-0.28232E+01,-0.28381E+01,-0.28531E+01,-0.28680E+01,-0.28829E+01, + &-0.28977E+01,-0.29125E+01,-0.29274E+01,-0.29421E+01,-0.29569E+01, + &-0.29716E+01,-0.29863E+01,-0.30010E+01,-0.30157E+01,-0.30303E+01, + &-0.30449E+01,-0.30595E+01,-0.30740E+01,-0.30886E+01,-0.31031E+01, + &-0.31176E+01,-0.31321E+01,-0.31465E+01,-0.31610E+01,-0.31754E+01, + &-0.31898E+01,-0.32042E+01,-0.32185E+01,-0.32328E+01,-0.32472E+01, + &-0.32614E+01,-0.32757E+01,-0.32900E+01,-0.33042E+01,-0.33184E+01, + &-0.33326E+01,-0.33468E+01,-0.33610E+01,-0.33751E+01,-0.33893E+01, + &-0.34034E+01,-0.34175E+01,-0.34316E+01,-0.34456E+01,-0.34597E+01, + &-0.34737E+01,-0.34877E+01,-0.35017E+01,-0.35157E+01,-0.35297E+01, + &-0.35436E+01,-0.35576E+01,-0.35715E+01,-0.35854E+01,-0.35993E+01/ + + DATA (BNC02M(I),I=701,741)/ + &-0.36132E+01,-0.36270E+01,-0.36409E+01,-0.36547E+01,-0.36685E+01, + &-0.36823E+01,-0.36961E+01,-0.37099E+01,-0.37237E+01,-0.37374E+01, + &-0.37512E+01,-0.37649E+01,-0.37786E+01,-0.37923E+01,-0.38060E+01, + &-0.38197E+01,-0.38333E+01,-0.38470E+01,-0.38606E+01,-0.38743E+01, + &-0.38879E+01,-0.39015E+01,-0.39151E+01,-0.39286E+01,-0.39422E+01, + &-0.39558E+01,-0.39693E+01,-0.39828E+01,-0.39964E+01,-0.40099E+01, + &-0.40234E+01,-0.40369E+01,-0.40503E+01,-0.40638E+01,-0.40773E+01, + &-0.40907E+01,-0.41041E+01,-0.41176E+01,-0.41310E+01,-0.41444E+01, + &-0.41578E+01 + & / +C +C *** NaNO3 +C + DATA (BNC03M (I),I= 1,100)/ + &-0.57178E-01,-0.10530E+00,-0.14005E+00,-0.16425E+00,-0.18329E+00, + &-0.19916E+00,-0.21288E+00,-0.22502E+00,-0.23595E+00,-0.24593E+00, + &-0.25513E+00,-0.26368E+00,-0.27167E+00,-0.27920E+00,-0.28633E+00, + &-0.29309E+00,-0.29954E+00,-0.30570E+00,-0.31162E+00,-0.31730E+00, + &-0.32278E+00,-0.32807E+00,-0.33318E+00,-0.33813E+00,-0.34294E+00, + &-0.34761E+00,-0.35215E+00,-0.35657E+00,-0.36088E+00,-0.36509E+00, + &-0.36920E+00,-0.37322E+00,-0.37715E+00,-0.38099E+00,-0.38476E+00, + &-0.38845E+00,-0.39207E+00,-0.39563E+00,-0.39912E+00,-0.40255E+00, + &-0.40592E+00,-0.40923E+00,-0.41249E+00,-0.41570E+00,-0.41885E+00, + &-0.42196E+00,-0.42503E+00,-0.42805E+00,-0.43102E+00,-0.43396E+00, + &-0.43685E+00,-0.43971E+00,-0.44253E+00,-0.44532E+00,-0.44807E+00, + &-0.45079E+00,-0.45347E+00,-0.45613E+00,-0.45875E+00,-0.46135E+00, + &-0.46392E+00,-0.46647E+00,-0.46898E+00,-0.47148E+00,-0.47394E+00, + &-0.47639E+00,-0.47881E+00,-0.48121E+00,-0.48360E+00,-0.48596E+00, + &-0.48830E+00,-0.49062E+00,-0.49293E+00,-0.49522E+00,-0.49749E+00, + &-0.49975E+00,-0.50199E+00,-0.50421E+00,-0.50642E+00,-0.50862E+00, + &-0.51081E+00,-0.51298E+00,-0.51514E+00,-0.51729E+00,-0.51942E+00, + &-0.52154E+00,-0.52366E+00,-0.52576E+00,-0.52785E+00,-0.52994E+00, + &-0.53201E+00,-0.53407E+00,-0.53613E+00,-0.53817E+00,-0.54021E+00, + &-0.54224E+00,-0.54426E+00,-0.54627E+00,-0.54827E+00,-0.55026E+00/ + + DATA (BNC03M (I),I=101,200)/ + &-0.55225E+00,-0.55423E+00,-0.55620E+00,-0.55817E+00,-0.56012E+00, + &-0.56207E+00,-0.56401E+00,-0.56595E+00,-0.56787E+00,-0.56979E+00, + &-0.57171E+00,-0.57361E+00,-0.57551E+00,-0.57740E+00,-0.57929E+00, + &-0.58116E+00,-0.58304E+00,-0.58490E+00,-0.58676E+00,-0.58861E+00, + &-0.59039E+00,-0.59224E+00,-0.59407E+00,-0.59590E+00,-0.59772E+00, + &-0.59954E+00,-0.60135E+00,-0.60315E+00,-0.60494E+00,-0.60673E+00, + &-0.60851E+00,-0.61029E+00,-0.61206E+00,-0.61382E+00,-0.61558E+00, + &-0.61733E+00,-0.61907E+00,-0.62081E+00,-0.62254E+00,-0.62427E+00, + &-0.62599E+00,-0.62770E+00,-0.62941E+00,-0.63111E+00,-0.63281E+00, + &-0.63450E+00,-0.63619E+00,-0.63787E+00,-0.63955E+00,-0.64122E+00, + &-0.64289E+00,-0.64455E+00,-0.64620E+00,-0.64785E+00,-0.64950E+00, + &-0.65114E+00,-0.65278E+00,-0.65441E+00,-0.65603E+00,-0.65766E+00, + &-0.65927E+00,-0.66089E+00,-0.66250E+00,-0.66410E+00,-0.66570E+00, + &-0.66729E+00,-0.66888E+00,-0.67047E+00,-0.67205E+00,-0.67363E+00, + &-0.67520E+00,-0.67677E+00,-0.67834E+00,-0.67990E+00,-0.68146E+00, + &-0.68301E+00,-0.68456E+00,-0.68610E+00,-0.68765E+00,-0.68918E+00, + &-0.69072E+00,-0.69225E+00,-0.69377E+00,-0.69530E+00,-0.69682E+00, + &-0.69833E+00,-0.69984E+00,-0.70135E+00,-0.70285E+00,-0.70436E+00, + &-0.70585E+00,-0.70735E+00,-0.70884E+00,-0.71032E+00,-0.71181E+00, + &-0.71329E+00,-0.71477E+00,-0.71624E+00,-0.71771E+00,-0.71918E+00/ + + DATA (BNC03M (I),I=201,300)/ + &-0.72064E+00,-0.72210E+00,-0.72356E+00,-0.72501E+00,-0.72647E+00, + &-0.72791E+00,-0.72936E+00,-0.73080E+00,-0.73224E+00,-0.73368E+00, + &-0.73511E+00,-0.73654E+00,-0.73797E+00,-0.73939E+00,-0.74082E+00, + &-0.74223E+00,-0.74365E+00,-0.74506E+00,-0.74647E+00,-0.74788E+00, + &-0.74929E+00,-0.75069E+00,-0.75209E+00,-0.75348E+00,-0.75488E+00, + &-0.75627E+00,-0.75766E+00,-0.75905E+00,-0.76043E+00,-0.76181E+00, + &-0.76319E+00,-0.76456E+00,-0.76594E+00,-0.76731E+00,-0.76868E+00, + &-0.77004E+00,-0.77141E+00,-0.77277E+00,-0.77413E+00,-0.77548E+00, + &-0.77684E+00,-0.77819E+00,-0.77954E+00,-0.78088E+00,-0.78223E+00, + &-0.78357E+00,-0.78491E+00,-0.78625E+00,-0.78758E+00,-0.78892E+00, + &-0.79025E+00,-0.79158E+00,-0.79290E+00,-0.79423E+00,-0.79555E+00, + &-0.79687E+00,-0.79819E+00,-0.79950E+00,-0.80081E+00,-0.80213E+00, + &-0.80344E+00,-0.80474E+00,-0.80605E+00,-0.80735E+00,-0.80865E+00, + &-0.80995E+00,-0.81125E+00,-0.81254E+00,-0.81384E+00,-0.81513E+00, + &-0.81642E+00,-0.81770E+00,-0.81899E+00,-0.82027E+00,-0.82155E+00, + &-0.82283E+00,-0.82411E+00,-0.82539E+00,-0.82666E+00,-0.82793E+00, + &-0.82920E+00,-0.83047E+00,-0.83173E+00,-0.83300E+00,-0.83426E+00, + &-0.83552E+00,-0.83678E+00,-0.83804E+00,-0.83929E+00,-0.84055E+00, + &-0.84180E+00,-0.84305E+00,-0.84430E+00,-0.84555E+00,-0.84679E+00, + &-0.84803E+00,-0.84928E+00,-0.85052E+00,-0.85175E+00,-0.85299E+00/ + + DATA (BNC03M (I),I=301,400)/ + &-0.85423E+00,-0.85546E+00,-0.85669E+00,-0.85792E+00,-0.85915E+00, + &-0.86038E+00,-0.86160E+00,-0.86282E+00,-0.86405E+00,-0.86527E+00, + &-0.86648E+00,-0.86770E+00,-0.86892E+00,-0.87013E+00,-0.87134E+00, + &-0.87256E+00,-0.87377E+00,-0.87497E+00,-0.87618E+00,-0.87738E+00, + &-0.87859E+00,-0.87979E+00,-0.88099E+00,-0.88219E+00,-0.88339E+00, + &-0.88458E+00,-0.88578E+00,-0.88697E+00,-0.88816E+00,-0.88935E+00, + &-0.89054E+00,-0.89173E+00,-0.89292E+00,-0.89410E+00,-0.89528E+00, + &-0.89647E+00,-0.89765E+00,-0.89883E+00,-0.90000E+00,-0.90118E+00, + &-0.90236E+00,-0.90353E+00,-0.90470E+00,-0.90587E+00,-0.90704E+00, + &-0.90821E+00,-0.90938E+00,-0.91054E+00,-0.91171E+00,-0.91287E+00, + &-0.91403E+00,-0.91519E+00,-0.91635E+00,-0.91751E+00,-0.91867E+00, + &-0.91982E+00,-0.92098E+00,-0.92213E+00,-0.92328E+00,-0.92443E+00, + &-0.92558E+00,-0.92673E+00,-0.92788E+00,-0.92902E+00,-0.93017E+00, + &-0.93131E+00,-0.93245E+00,-0.93359E+00,-0.93473E+00,-0.93587E+00, + &-0.93701E+00,-0.93815E+00,-0.93928E+00,-0.94041E+00,-0.94155E+00, + &-0.94268E+00,-0.94381E+00,-0.94494E+00,-0.94607E+00,-0.94719E+00, + &-0.94832E+00,-0.94944E+00,-0.95057E+00,-0.95169E+00,-0.95281E+00, + &-0.95393E+00,-0.95505E+00,-0.95617E+00,-0.95729E+00,-0.95840E+00, + &-0.95952E+00,-0.96063E+00,-0.96174E+00,-0.96285E+00,-0.96396E+00, + &-0.96507E+00,-0.96618E+00,-0.96729E+00,-0.96840E+00,-0.96950E+00/ + + DATA (BNC03M (I),I=401,500)/ + &-0.97061E+00,-0.97171E+00,-0.97281E+00,-0.97391E+00,-0.97501E+00, + &-0.97611E+00,-0.97721E+00,-0.97831E+00,-0.97940E+00,-0.98050E+00, + &-0.98159E+00,-0.98268E+00,-0.98378E+00,-0.98487E+00,-0.98596E+00, + &-0.98705E+00,-0.98813E+00,-0.98922E+00,-0.99031E+00,-0.99139E+00, + &-0.99248E+00,-0.99356E+00,-0.99464E+00,-0.99572E+00,-0.99681E+00, + &-0.99788E+00,-0.99896E+00,-0.10000E+01,-0.10011E+01,-0.10022E+01, + &-0.10033E+01,-0.10043E+01,-0.10054E+01,-0.10065E+01,-0.10076E+01, + &-0.10086E+01,-0.10097E+01,-0.10108E+01,-0.10118E+01,-0.10129E+01, + &-0.10140E+01,-0.10150E+01,-0.10161E+01,-0.10172E+01,-0.10182E+01, + &-0.10193E+01,-0.10203E+01,-0.10214E+01,-0.10225E+01,-0.10235E+01, + &-0.10246E+01,-0.10256E+01,-0.10267E+01,-0.10277E+01,-0.10288E+01, + &-0.10299E+01,-0.10309E+01,-0.10320E+01,-0.10330E+01,-0.10341E+01, + &-0.10351E+01,-0.10362E+01,-0.10372E+01,-0.10382E+01,-0.10393E+01, + &-0.10403E+01,-0.10414E+01,-0.10424E+01,-0.10435E+01,-0.10445E+01, + &-0.10455E+01,-0.10466E+01,-0.10476E+01,-0.10487E+01,-0.10497E+01, + &-0.10507E+01,-0.10518E+01,-0.10528E+01,-0.10538E+01,-0.10549E+01, + &-0.10559E+01,-0.10569E+01,-0.10580E+01,-0.10590E+01,-0.10600E+01, + &-0.10611E+01,-0.10621E+01,-0.10631E+01,-0.10642E+01,-0.10652E+01, + &-0.10662E+01,-0.10672E+01,-0.10683E+01,-0.10693E+01,-0.10703E+01, + &-0.10713E+01,-0.10723E+01,-0.10734E+01,-0.10744E+01,-0.10754E+01/ + + DATA (BNC03M (I),I=501,600)/ + &-0.10764E+01,-0.10774E+01,-0.10785E+01,-0.10795E+01,-0.10805E+01, + &-0.10815E+01,-0.10825E+01,-0.10835E+01,-0.10845E+01,-0.10855E+01, + &-0.10866E+01,-0.10876E+01,-0.10886E+01,-0.10896E+01,-0.10906E+01, + &-0.10916E+01,-0.10926E+01,-0.10936E+01,-0.10946E+01,-0.10956E+01, + &-0.10966E+01,-0.10976E+01,-0.10986E+01,-0.10996E+01,-0.11006E+01, + &-0.11016E+01,-0.11026E+01,-0.11036E+01,-0.11046E+01,-0.11056E+01, + &-0.11066E+01,-0.11076E+01,-0.11086E+01,-0.11096E+01,-0.11106E+01, + &-0.11116E+01,-0.11126E+01,-0.11136E+01,-0.11146E+01,-0.11156E+01, + &-0.11166E+01,-0.11176E+01,-0.11186E+01,-0.11196E+01,-0.11205E+01, + &-0.11215E+01,-0.11225E+01,-0.11235E+01,-0.11245E+01,-0.11255E+01, + &-0.11265E+01,-0.11274E+01,-0.11284E+01,-0.11294E+01,-0.11304E+01, + &-0.11314E+01,-0.11324E+01,-0.11333E+01,-0.11343E+01,-0.11353E+01, + &-0.11363E+01,-0.11373E+01,-0.11382E+01,-0.11392E+01,-0.11402E+01, + &-0.11412E+01,-0.11421E+01,-0.11431E+01,-0.11441E+01,-0.11451E+01, + &-0.11460E+01,-0.11470E+01,-0.11480E+01,-0.11490E+01,-0.11499E+01, + &-0.11509E+01,-0.11519E+01,-0.11528E+01,-0.11538E+01,-0.11548E+01, + &-0.11557E+01,-0.11567E+01,-0.11577E+01,-0.11586E+01,-0.11596E+01, + &-0.11606E+01,-0.11615E+01,-0.11625E+01,-0.11635E+01,-0.11644E+01, + &-0.11654E+01,-0.11663E+01,-0.11673E+01,-0.11683E+01,-0.11692E+01, + &-0.11702E+01,-0.11711E+01,-0.11721E+01,-0.11731E+01,-0.11766E+01/ + + DATA (BNC03M (I),I=601,700)/ + &-0.11845E+01,-0.11940E+01,-0.12034E+01,-0.12128E+01,-0.12222E+01, + &-0.12315E+01,-0.12407E+01,-0.12499E+01,-0.12591E+01,-0.12682E+01, + &-0.12773E+01,-0.12863E+01,-0.12953E+01,-0.13043E+01,-0.13132E+01, + &-0.13221E+01,-0.13310E+01,-0.13398E+01,-0.13486E+01,-0.13573E+01, + &-0.13660E+01,-0.13747E+01,-0.13834E+01,-0.13920E+01,-0.14006E+01, + &-0.14092E+01,-0.14177E+01,-0.14262E+01,-0.14347E+01,-0.14432E+01, + &-0.14516E+01,-0.14600E+01,-0.14684E+01,-0.14768E+01,-0.14851E+01, + &-0.14934E+01,-0.15017E+01,-0.15099E+01,-0.15182E+01,-0.15264E+01, + &-0.15346E+01,-0.15427E+01,-0.15509E+01,-0.15590E+01,-0.15671E+01, + &-0.15752E+01,-0.15833E+01,-0.15913E+01,-0.15993E+01,-0.16073E+01, + &-0.16153E+01,-0.16233E+01,-0.16313E+01,-0.16392E+01,-0.16471E+01, + &-0.16550E+01,-0.16629E+01,-0.16707E+01,-0.16786E+01,-0.16864E+01, + &-0.16942E+01,-0.17020E+01,-0.17098E+01,-0.17176E+01,-0.17253E+01, + &-0.17331E+01,-0.17408E+01,-0.17485E+01,-0.17562E+01,-0.17639E+01, + &-0.17715E+01,-0.17792E+01,-0.17868E+01,-0.17944E+01,-0.18021E+01, + &-0.18096E+01,-0.18172E+01,-0.18248E+01,-0.18324E+01,-0.18399E+01, + &-0.18474E+01,-0.18550E+01,-0.18625E+01,-0.18700E+01,-0.18774E+01, + &-0.18849E+01,-0.18924E+01,-0.18998E+01,-0.19073E+01,-0.19147E+01, + &-0.19221E+01,-0.19295E+01,-0.19369E+01,-0.19443E+01,-0.19516E+01, + &-0.19590E+01,-0.19664E+01,-0.19737E+01,-0.19810E+01,-0.19883E+01/ + + DATA (BNC03M(I),I=701,741)/ + &-0.19957E+01,-0.20030E+01,-0.20102E+01,-0.20175E+01,-0.20248E+01, + &-0.20321E+01,-0.20393E+01,-0.20466E+01,-0.20538E+01,-0.20610E+01, + &-0.20682E+01,-0.20754E+01,-0.20826E+01,-0.20898E+01,-0.20970E+01, + &-0.21042E+01,-0.21113E+01,-0.21185E+01,-0.21256E+01,-0.21328E+01, + &-0.21399E+01,-0.21470E+01,-0.21542E+01,-0.21613E+01,-0.21684E+01, + &-0.21754E+01,-0.21825E+01,-0.21896E+01,-0.21967E+01,-0.22037E+01, + &-0.22108E+01,-0.22178E+01,-0.22249E+01,-0.22319E+01,-0.22389E+01, + &-0.22459E+01,-0.22530E+01,-0.22600E+01,-0.22670E+01,-0.22739E+01, + &-0.22809E+01 + & / +C +C *** (NH4)2SO4 +C + DATA (BNC04M (I),I= 1,100)/ + &-0.11406E+00,-0.20949E+00,-0.27798E+00,-0.32543E+00,-0.36258E+00, + &-0.39344E+00,-0.42000E+00,-0.44344E+00,-0.46447E+00,-0.48360E+00, + &-0.50119E+00,-0.51749E+00,-0.53270E+00,-0.54698E+00,-0.56046E+00, + &-0.57323E+00,-0.58538E+00,-0.59697E+00,-0.60807E+00,-0.61871E+00, + &-0.62895E+00,-0.63882E+00,-0.64835E+00,-0.65756E+00,-0.66649E+00, + &-0.67515E+00,-0.68356E+00,-0.69174E+00,-0.69971E+00,-0.70747E+00, + &-0.71505E+00,-0.72244E+00,-0.72967E+00,-0.73674E+00,-0.74366E+00, + &-0.75044E+00,-0.75708E+00,-0.76359E+00,-0.76998E+00,-0.77626E+00, + &-0.78242E+00,-0.78847E+00,-0.79443E+00,-0.80028E+00,-0.80605E+00, + &-0.81172E+00,-0.81731E+00,-0.82281E+00,-0.82823E+00,-0.83358E+00, + &-0.83886E+00,-0.84406E+00,-0.84919E+00,-0.85426E+00,-0.85927E+00, + &-0.86421E+00,-0.86910E+00,-0.87392E+00,-0.87870E+00,-0.88342E+00, + &-0.88808E+00,-0.89270E+00,-0.89727E+00,-0.90180E+00,-0.90628E+00, + &-0.91072E+00,-0.91511E+00,-0.91947E+00,-0.92378E+00,-0.92806E+00, + &-0.93230E+00,-0.93651E+00,-0.94069E+00,-0.94483E+00,-0.94894E+00, + &-0.95301E+00,-0.95706E+00,-0.96108E+00,-0.96508E+00,-0.96904E+00, + &-0.97298E+00,-0.97690E+00,-0.98079E+00,-0.98466E+00,-0.98850E+00, + &-0.99232E+00,-0.99612E+00,-0.99990E+00,-0.10037E+01,-0.10074E+01, + &-0.10111E+01,-0.10148E+01,-0.10185E+01,-0.10222E+01,-0.10258E+01, + &-0.10294E+01,-0.10331E+01,-0.10366E+01,-0.10402E+01,-0.10438E+01/ + + DATA (BNC04M (I),I=101,200)/ + &-0.10473E+01,-0.10509E+01,-0.10544E+01,-0.10579E+01,-0.10614E+01, + &-0.10648E+01,-0.10683E+01,-0.10718E+01,-0.10752E+01,-0.10786E+01, + &-0.10820E+01,-0.10854E+01,-0.10888E+01,-0.10921E+01,-0.10955E+01, + &-0.10988E+01,-0.11021E+01,-0.11054E+01,-0.11087E+01,-0.11120E+01, + &-0.11152E+01,-0.11185E+01,-0.11217E+01,-0.11250E+01,-0.11282E+01, + &-0.11314E+01,-0.11346E+01,-0.11378E+01,-0.11410E+01,-0.11442E+01, + &-0.11473E+01,-0.11505E+01,-0.11536E+01,-0.11567E+01,-0.11598E+01, + &-0.11629E+01,-0.11660E+01,-0.11691E+01,-0.11722E+01,-0.11752E+01, + &-0.11783E+01,-0.11813E+01,-0.11844E+01,-0.11874E+01,-0.11904E+01, + &-0.11934E+01,-0.11964E+01,-0.11994E+01,-0.12023E+01,-0.12053E+01, + &-0.12082E+01,-0.12112E+01,-0.12141E+01,-0.12171E+01,-0.12200E+01, + &-0.12229E+01,-0.12258E+01,-0.12287E+01,-0.12316E+01,-0.12344E+01, + &-0.12373E+01,-0.12402E+01,-0.12430E+01,-0.12459E+01,-0.12487E+01, + &-0.12515E+01,-0.12544E+01,-0.12572E+01,-0.12600E+01,-0.12628E+01, + &-0.12656E+01,-0.12683E+01,-0.12711E+01,-0.12739E+01,-0.12767E+01, + &-0.12794E+01,-0.12822E+01,-0.12849E+01,-0.12876E+01,-0.12904E+01, + &-0.12931E+01,-0.12958E+01,-0.12985E+01,-0.13012E+01,-0.13039E+01, + &-0.13066E+01,-0.13093E+01,-0.13120E+01,-0.13147E+01,-0.13173E+01, + &-0.13200E+01,-0.13226E+01,-0.13253E+01,-0.13279E+01,-0.13306E+01, + &-0.13332E+01,-0.13358E+01,-0.13385E+01,-0.13411E+01,-0.13437E+01/ + + DATA (BNC04M (I),I=201,300)/ + &-0.13463E+01,-0.13489E+01,-0.13515E+01,-0.13541E+01,-0.13567E+01, + &-0.13592E+01,-0.13618E+01,-0.13644E+01,-0.13669E+01,-0.13695E+01, + &-0.13720E+01,-0.13746E+01,-0.13771E+01,-0.13797E+01,-0.13822E+01, + &-0.13847E+01,-0.13873E+01,-0.13898E+01,-0.13923E+01,-0.13948E+01, + &-0.13973E+01,-0.13998E+01,-0.14023E+01,-0.14048E+01,-0.14073E+01, + &-0.14098E+01,-0.14122E+01,-0.14147E+01,-0.14172E+01,-0.14196E+01, + &-0.14221E+01,-0.14245E+01,-0.14270E+01,-0.14294E+01,-0.14319E+01, + &-0.14343E+01,-0.14368E+01,-0.14392E+01,-0.14416E+01,-0.14440E+01, + &-0.14465E+01,-0.14489E+01,-0.14513E+01,-0.14537E+01,-0.14561E+01, + &-0.14585E+01,-0.14609E+01,-0.14633E+01,-0.14657E+01,-0.14681E+01, + &-0.14704E+01,-0.14728E+01,-0.14752E+01,-0.14776E+01,-0.14799E+01, + &-0.14823E+01,-0.14846E+01,-0.14870E+01,-0.14893E+01,-0.14917E+01, + &-0.14940E+01,-0.14964E+01,-0.14987E+01,-0.15011E+01,-0.15034E+01, + &-0.15057E+01,-0.15080E+01,-0.15104E+01,-0.15127E+01,-0.15150E+01, + &-0.15173E+01,-0.15196E+01,-0.15219E+01,-0.15242E+01,-0.15265E+01, + &-0.15288E+01,-0.15311E+01,-0.15334E+01,-0.15357E+01,-0.15380E+01, + &-0.15402E+01,-0.15425E+01,-0.15448E+01,-0.15471E+01,-0.15493E+01, + &-0.15516E+01,-0.15538E+01,-0.15561E+01,-0.15584E+01,-0.15606E+01, + &-0.15629E+01,-0.15651E+01,-0.15674E+01,-0.15696E+01,-0.15718E+01, + &-0.15741E+01,-0.15763E+01,-0.15785E+01,-0.15808E+01,-0.15830E+01/ + + DATA (BNC04M (I),I=301,400)/ + &-0.15852E+01,-0.15874E+01,-0.15896E+01,-0.15919E+01,-0.15941E+01, + &-0.15963E+01,-0.15985E+01,-0.16007E+01,-0.16029E+01,-0.16051E+01, + &-0.16073E+01,-0.16095E+01,-0.16117E+01,-0.16138E+01,-0.16160E+01, + &-0.16182E+01,-0.16204E+01,-0.16226E+01,-0.16247E+01,-0.16269E+01, + &-0.16291E+01,-0.16313E+01,-0.16334E+01,-0.16356E+01,-0.16377E+01, + &-0.16399E+01,-0.16421E+01,-0.16442E+01,-0.16464E+01,-0.16485E+01, + &-0.16507E+01,-0.16528E+01,-0.16549E+01,-0.16571E+01,-0.16592E+01, + &-0.16614E+01,-0.16635E+01,-0.16656E+01,-0.16678E+01,-0.16699E+01, + &-0.16720E+01,-0.16741E+01,-0.16762E+01,-0.16784E+01,-0.16805E+01, + &-0.16826E+01,-0.16847E+01,-0.16868E+01,-0.16889E+01,-0.16910E+01, + &-0.16931E+01,-0.16952E+01,-0.16973E+01,-0.16994E+01,-0.17015E+01, + &-0.17036E+01,-0.17057E+01,-0.17078E+01,-0.17099E+01,-0.17120E+01, + &-0.17140E+01,-0.17161E+01,-0.17182E+01,-0.17203E+01,-0.17223E+01, + &-0.17244E+01,-0.17265E+01,-0.17286E+01,-0.17306E+01,-0.17327E+01, + &-0.17348E+01,-0.17368E+01,-0.17389E+01,-0.17409E+01,-0.17430E+01, + &-0.17450E+01,-0.17471E+01,-0.17491E+01,-0.17512E+01,-0.17532E+01, + &-0.17553E+01,-0.17573E+01,-0.17594E+01,-0.17614E+01,-0.17634E+01, + &-0.17655E+01,-0.17675E+01,-0.17695E+01,-0.17716E+01,-0.17736E+01, + &-0.17756E+01,-0.17776E+01,-0.17797E+01,-0.17817E+01,-0.17837E+01, + &-0.17857E+01,-0.17877E+01,-0.17898E+01,-0.17918E+01,-0.17938E+01/ + + DATA (BNC04M (I),I=401,500)/ + &-0.17958E+01,-0.17978E+01,-0.17998E+01,-0.18018E+01,-0.18038E+01, + &-0.18058E+01,-0.18078E+01,-0.18098E+01,-0.18118E+01,-0.18138E+01, + &-0.18158E+01,-0.18178E+01,-0.18198E+01,-0.18218E+01,-0.18238E+01, + &-0.18257E+01,-0.18277E+01,-0.18297E+01,-0.18317E+01,-0.18337E+01, + &-0.18356E+01,-0.18376E+01,-0.18396E+01,-0.18416E+01,-0.18435E+01, + &-0.18455E+01,-0.18475E+01,-0.18494E+01,-0.18514E+01,-0.18534E+01, + &-0.18553E+01,-0.18573E+01,-0.18593E+01,-0.18612E+01,-0.18632E+01, + &-0.18651E+01,-0.18671E+01,-0.18690E+01,-0.18710E+01,-0.18729E+01, + &-0.18749E+01,-0.18768E+01,-0.18788E+01,-0.18807E+01,-0.18827E+01, + &-0.18846E+01,-0.18865E+01,-0.18885E+01,-0.18904E+01,-0.18923E+01, + &-0.18943E+01,-0.18962E+01,-0.18981E+01,-0.19001E+01,-0.19020E+01, + &-0.19039E+01,-0.19058E+01,-0.19078E+01,-0.19097E+01,-0.19116E+01, + &-0.19135E+01,-0.19155E+01,-0.19174E+01,-0.19193E+01,-0.19212E+01, + &-0.19231E+01,-0.19250E+01,-0.19269E+01,-0.19289E+01,-0.19308E+01, + &-0.19327E+01,-0.19346E+01,-0.19365E+01,-0.19384E+01,-0.19403E+01, + &-0.19422E+01,-0.19441E+01,-0.19460E+01,-0.19479E+01,-0.19498E+01, + &-0.19517E+01,-0.19536E+01,-0.19555E+01,-0.19574E+01,-0.19592E+01, + &-0.19611E+01,-0.19630E+01,-0.19649E+01,-0.19668E+01,-0.19687E+01, + &-0.19706E+01,-0.19724E+01,-0.19743E+01,-0.19762E+01,-0.19781E+01, + &-0.19800E+01,-0.19818E+01,-0.19837E+01,-0.19856E+01,-0.19875E+01/ + + DATA (BNC04M (I),I=501,600)/ + &-0.19893E+01,-0.19912E+01,-0.19931E+01,-0.19949E+01,-0.19968E+01, + &-0.19987E+01,-0.20005E+01,-0.20024E+01,-0.20043E+01,-0.20061E+01, + &-0.20080E+01,-0.20098E+01,-0.20117E+01,-0.20136E+01,-0.20154E+01, + &-0.20173E+01,-0.20191E+01,-0.20210E+01,-0.20228E+01,-0.20247E+01, + &-0.20265E+01,-0.20284E+01,-0.20302E+01,-0.20321E+01,-0.20339E+01, + &-0.20358E+01,-0.20376E+01,-0.20394E+01,-0.20413E+01,-0.20431E+01, + &-0.20450E+01,-0.20468E+01,-0.20486E+01,-0.20505E+01,-0.20523E+01, + &-0.20541E+01,-0.20560E+01,-0.20578E+01,-0.20596E+01,-0.20615E+01, + &-0.20633E+01,-0.20651E+01,-0.20669E+01,-0.20688E+01,-0.20706E+01, + &-0.20724E+01,-0.20742E+01,-0.20761E+01,-0.20779E+01,-0.20797E+01, + &-0.20815E+01,-0.20833E+01,-0.20852E+01,-0.20870E+01,-0.20888E+01, + &-0.20906E+01,-0.20924E+01,-0.20942E+01,-0.20960E+01,-0.20979E+01, + &-0.20997E+01,-0.21015E+01,-0.21033E+01,-0.21051E+01,-0.21069E+01, + &-0.21087E+01,-0.21105E+01,-0.21123E+01,-0.21141E+01,-0.21159E+01, + &-0.21177E+01,-0.21195E+01,-0.21213E+01,-0.21231E+01,-0.21249E+01, + &-0.21267E+01,-0.21285E+01,-0.21303E+01,-0.21321E+01,-0.21339E+01, + &-0.21356E+01,-0.21374E+01,-0.21392E+01,-0.21410E+01,-0.21428E+01, + &-0.21446E+01,-0.21464E+01,-0.21482E+01,-0.21499E+01,-0.21517E+01, + &-0.21535E+01,-0.21553E+01,-0.21571E+01,-0.21588E+01,-0.21606E+01, + &-0.21624E+01,-0.21642E+01,-0.21660E+01,-0.21677E+01,-0.21744E+01/ + + DATA (BNC04M (I),I=601,700)/ + &-0.21890E+01,-0.22066E+01,-0.22241E+01,-0.22416E+01,-0.22589E+01, + &-0.22762E+01,-0.22935E+01,-0.23106E+01,-0.23277E+01,-0.23448E+01, + &-0.23617E+01,-0.23786E+01,-0.23955E+01,-0.24122E+01,-0.24290E+01, + &-0.24456E+01,-0.24622E+01,-0.24788E+01,-0.24953E+01,-0.25117E+01, + &-0.25281E+01,-0.25445E+01,-0.25608E+01,-0.25770E+01,-0.25932E+01, + &-0.26094E+01,-0.26255E+01,-0.26415E+01,-0.26575E+01,-0.26735E+01, + &-0.26894E+01,-0.27053E+01,-0.27212E+01,-0.27370E+01,-0.27528E+01, + &-0.27685E+01,-0.27842E+01,-0.27998E+01,-0.28155E+01,-0.28310E+01, + &-0.28466E+01,-0.28621E+01,-0.28776E+01,-0.28930E+01,-0.29084E+01, + &-0.29238E+01,-0.29392E+01,-0.29545E+01,-0.29698E+01,-0.29850E+01, + &-0.30002E+01,-0.30154E+01,-0.30306E+01,-0.30457E+01,-0.30608E+01, + &-0.30759E+01,-0.30910E+01,-0.31060E+01,-0.31210E+01,-0.31360E+01, + &-0.31509E+01,-0.31658E+01,-0.31807E+01,-0.31956E+01,-0.32104E+01, + &-0.32252E+01,-0.32400E+01,-0.32548E+01,-0.32696E+01,-0.32843E+01, + &-0.32990E+01,-0.33137E+01,-0.33283E+01,-0.33430E+01,-0.33576E+01, + &-0.33722E+01,-0.33867E+01,-0.34013E+01,-0.34158E+01,-0.34303E+01, + &-0.34448E+01,-0.34593E+01,-0.34737E+01,-0.34882E+01,-0.35026E+01, + &-0.35170E+01,-0.35313E+01,-0.35457E+01,-0.35600E+01,-0.35743E+01, + &-0.35886E+01,-0.36029E+01,-0.36172E+01,-0.36314E+01,-0.36456E+01, + &-0.36599E+01,-0.36741E+01,-0.36882E+01,-0.37024E+01,-0.37165E+01/ + + DATA (BNC04M(I),I=701,741)/ + &-0.37307E+01,-0.37448E+01,-0.37589E+01,-0.37730E+01,-0.37870E+01, + &-0.38011E+01,-0.38151E+01,-0.38291E+01,-0.38431E+01,-0.38571E+01, + &-0.38711E+01,-0.38850E+01,-0.38990E+01,-0.39129E+01,-0.39268E+01, + &-0.39407E+01,-0.39546E+01,-0.39685E+01,-0.39824E+01,-0.39962E+01, + &-0.40100E+01,-0.40239E+01,-0.40377E+01,-0.40515E+01,-0.40653E+01, + &-0.40790E+01,-0.40928E+01,-0.41065E+01,-0.41203E+01,-0.41340E+01, + &-0.41477E+01,-0.41614E+01,-0.41751E+01,-0.41887E+01,-0.42024E+01, + &-0.42160E+01,-0.42297E+01,-0.42433E+01,-0.42569E+01,-0.42705E+01, + &-0.42841E+01 + & / +C +C *** NH4NO3 +C + DATA (BNC05M (I),I= 1,100)/ + &-0.58030E-01,-0.10848E+00,-0.14612E+00,-0.17306E+00,-0.19474E+00, + &-0.21318E+00,-0.22940E+00,-0.24400E+00,-0.25734E+00,-0.26968E+00, + &-0.28121E+00,-0.29205E+00,-0.30231E+00,-0.31208E+00,-0.32141E+00, + &-0.33035E+00,-0.33895E+00,-0.34724E+00,-0.35526E+00,-0.36302E+00, + &-0.37055E+00,-0.37787E+00,-0.38499E+00,-0.39194E+00,-0.39871E+00, + &-0.40532E+00,-0.41178E+00,-0.41811E+00,-0.42430E+00,-0.43037E+00, + &-0.43632E+00,-0.44215E+00,-0.44788E+00,-0.45350E+00,-0.45902E+00, + &-0.46446E+00,-0.46979E+00,-0.47505E+00,-0.48021E+00,-0.48530E+00, + &-0.49031E+00,-0.49524E+00,-0.50010E+00,-0.50489E+00,-0.50962E+00, + &-0.51427E+00,-0.51886E+00,-0.52339E+00,-0.52786E+00,-0.53228E+00, + &-0.53663E+00,-0.54094E+00,-0.54519E+00,-0.54939E+00,-0.55354E+00, + &-0.55764E+00,-0.56170E+00,-0.56571E+00,-0.56968E+00,-0.57361E+00, + &-0.57750E+00,-0.58136E+00,-0.58517E+00,-0.58895E+00,-0.59270E+00, + &-0.59641E+00,-0.60010E+00,-0.60375E+00,-0.60738E+00,-0.61098E+00, + &-0.61455E+00,-0.61810E+00,-0.62162E+00,-0.62512E+00,-0.62860E+00, + &-0.63206E+00,-0.63550E+00,-0.63892E+00,-0.64233E+00,-0.64571E+00, + &-0.64908E+00,-0.65244E+00,-0.65578E+00,-0.65911E+00,-0.66242E+00, + &-0.66572E+00,-0.66901E+00,-0.67228E+00,-0.67555E+00,-0.67880E+00, + &-0.68205E+00,-0.68528E+00,-0.68850E+00,-0.69171E+00,-0.69492E+00, + &-0.69811E+00,-0.70130E+00,-0.70447E+00,-0.70764E+00,-0.71080E+00/ + + DATA (BNC05M (I),I=101,200)/ + &-0.71394E+00,-0.71708E+00,-0.72021E+00,-0.72334E+00,-0.72645E+00, + &-0.72955E+00,-0.73265E+00,-0.73573E+00,-0.73881E+00,-0.74187E+00, + &-0.74493E+00,-0.74798E+00,-0.75101E+00,-0.75404E+00,-0.75706E+00, + &-0.76007E+00,-0.76307E+00,-0.76606E+00,-0.76903E+00,-0.77200E+00, + &-0.77479E+00,-0.77776E+00,-0.78071E+00,-0.78366E+00,-0.78659E+00, + &-0.78951E+00,-0.79242E+00,-0.79531E+00,-0.79820E+00,-0.80107E+00, + &-0.80393E+00,-0.80678E+00,-0.80962E+00,-0.81245E+00,-0.81527E+00, + &-0.81808E+00,-0.82087E+00,-0.82366E+00,-0.82644E+00,-0.82920E+00, + &-0.83196E+00,-0.83470E+00,-0.83744E+00,-0.84016E+00,-0.84288E+00, + &-0.84558E+00,-0.84828E+00,-0.85097E+00,-0.85365E+00,-0.85631E+00, + &-0.85897E+00,-0.86162E+00,-0.86426E+00,-0.86689E+00,-0.86951E+00, + &-0.87213E+00,-0.87473E+00,-0.87733E+00,-0.87992E+00,-0.88249E+00, + &-0.88506E+00,-0.88763E+00,-0.89018E+00,-0.89272E+00,-0.89526E+00, + &-0.89779E+00,-0.90031E+00,-0.90282E+00,-0.90532E+00,-0.90782E+00, + &-0.91031E+00,-0.91279E+00,-0.91526E+00,-0.91773E+00,-0.92019E+00, + &-0.92264E+00,-0.92508E+00,-0.92751E+00,-0.92994E+00,-0.93236E+00, + &-0.93477E+00,-0.93718E+00,-0.93958E+00,-0.94197E+00,-0.94435E+00, + &-0.94673E+00,-0.94910E+00,-0.95147E+00,-0.95382E+00,-0.95617E+00, + &-0.95852E+00,-0.96085E+00,-0.96318E+00,-0.96550E+00,-0.96782E+00, + &-0.97013E+00,-0.97243E+00,-0.97473E+00,-0.97702E+00,-0.97931E+00/ + + DATA (BNC05M (I),I=201,300)/ + &-0.98158E+00,-0.98386E+00,-0.98612E+00,-0.98838E+00,-0.99063E+00, + &-0.99288E+00,-0.99512E+00,-0.99736E+00,-0.99959E+00,-0.10018E+01, + &-0.10040E+01,-0.10062E+01,-0.10084E+01,-0.10106E+01,-0.10128E+01, + &-0.10150E+01,-0.10172E+01,-0.10194E+01,-0.10216E+01,-0.10237E+01, + &-0.10259E+01,-0.10280E+01,-0.10302E+01,-0.10323E+01,-0.10345E+01, + &-0.10366E+01,-0.10387E+01,-0.10409E+01,-0.10430E+01,-0.10451E+01, + &-0.10472E+01,-0.10493E+01,-0.10514E+01,-0.10535E+01,-0.10556E+01, + &-0.10576E+01,-0.10597E+01,-0.10618E+01,-0.10639E+01,-0.10659E+01, + &-0.10680E+01,-0.10700E+01,-0.10721E+01,-0.10741E+01,-0.10762E+01, + &-0.10782E+01,-0.10802E+01,-0.10822E+01,-0.10843E+01,-0.10863E+01, + &-0.10883E+01,-0.10903E+01,-0.10923E+01,-0.10943E+01,-0.10963E+01, + &-0.10983E+01,-0.11002E+01,-0.11022E+01,-0.11042E+01,-0.11062E+01, + &-0.11081E+01,-0.11101E+01,-0.11120E+01,-0.11140E+01,-0.11159E+01, + &-0.11179E+01,-0.11198E+01,-0.11218E+01,-0.11237E+01,-0.11256E+01, + &-0.11275E+01,-0.11294E+01,-0.11314E+01,-0.11333E+01,-0.11352E+01, + &-0.11371E+01,-0.11390E+01,-0.11409E+01,-0.11428E+01,-0.11446E+01, + &-0.11465E+01,-0.11484E+01,-0.11503E+01,-0.11522E+01,-0.11540E+01, + &-0.11559E+01,-0.11577E+01,-0.11596E+01,-0.11614E+01,-0.11633E+01, + &-0.11651E+01,-0.11670E+01,-0.11688E+01,-0.11706E+01,-0.11725E+01, + &-0.11743E+01,-0.11761E+01,-0.11779E+01,-0.11798E+01,-0.11816E+01/ + + DATA (BNC05M (I),I=301,400)/ + &-0.11834E+01,-0.11852E+01,-0.11870E+01,-0.11888E+01,-0.11906E+01, + &-0.11924E+01,-0.11941E+01,-0.11959E+01,-0.11977E+01,-0.11995E+01, + &-0.12013E+01,-0.12030E+01,-0.12048E+01,-0.12066E+01,-0.12083E+01, + &-0.12101E+01,-0.12118E+01,-0.12136E+01,-0.12153E+01,-0.12171E+01, + &-0.12188E+01,-0.12205E+01,-0.12223E+01,-0.12240E+01,-0.12257E+01, + &-0.12275E+01,-0.12292E+01,-0.12309E+01,-0.12326E+01,-0.12343E+01, + &-0.12360E+01,-0.12377E+01,-0.12394E+01,-0.12411E+01,-0.12428E+01, + &-0.12445E+01,-0.12462E+01,-0.12479E+01,-0.12496E+01,-0.12513E+01, + &-0.12530E+01,-0.12546E+01,-0.12563E+01,-0.12580E+01,-0.12596E+01, + &-0.12613E+01,-0.12630E+01,-0.12646E+01,-0.12663E+01,-0.12679E+01, + &-0.12696E+01,-0.12712E+01,-0.12729E+01,-0.12745E+01,-0.12762E+01, + &-0.12778E+01,-0.12794E+01,-0.12811E+01,-0.12827E+01,-0.12843E+01, + &-0.12859E+01,-0.12876E+01,-0.12892E+01,-0.12908E+01,-0.12924E+01, + &-0.12940E+01,-0.12956E+01,-0.12972E+01,-0.12988E+01,-0.13004E+01, + &-0.13020E+01,-0.13036E+01,-0.13052E+01,-0.13068E+01,-0.13084E+01, + &-0.13100E+01,-0.13116E+01,-0.13131E+01,-0.13147E+01,-0.13163E+01, + &-0.13179E+01,-0.13194E+01,-0.13210E+01,-0.13226E+01,-0.13241E+01, + &-0.13257E+01,-0.13272E+01,-0.13288E+01,-0.13303E+01,-0.13319E+01, + &-0.13334E+01,-0.13350E+01,-0.13365E+01,-0.13381E+01,-0.13396E+01, + &-0.13411E+01,-0.13427E+01,-0.13442E+01,-0.13457E+01,-0.13473E+01/ + + DATA (BNC05M (I),I=401,500)/ + &-0.13488E+01,-0.13503E+01,-0.13518E+01,-0.13533E+01,-0.13549E+01, + &-0.13564E+01,-0.13579E+01,-0.13594E+01,-0.13609E+01,-0.13624E+01, + &-0.13639E+01,-0.13654E+01,-0.13669E+01,-0.13684E+01,-0.13699E+01, + &-0.13714E+01,-0.13729E+01,-0.13744E+01,-0.13758E+01,-0.13773E+01, + &-0.13788E+01,-0.13803E+01,-0.13818E+01,-0.13832E+01,-0.13847E+01, + &-0.13862E+01,-0.13877E+01,-0.13891E+01,-0.13906E+01,-0.13920E+01, + &-0.13935E+01,-0.13950E+01,-0.13964E+01,-0.13979E+01,-0.13993E+01, + &-0.14008E+01,-0.14022E+01,-0.14037E+01,-0.14051E+01,-0.14066E+01, + &-0.14080E+01,-0.14094E+01,-0.14109E+01,-0.14123E+01,-0.14137E+01, + &-0.14152E+01,-0.14166E+01,-0.14180E+01,-0.14195E+01,-0.14209E+01, + &-0.14223E+01,-0.14237E+01,-0.14251E+01,-0.14266E+01,-0.14280E+01, + &-0.14294E+01,-0.14308E+01,-0.14322E+01,-0.14336E+01,-0.14350E+01, + &-0.14364E+01,-0.14378E+01,-0.14392E+01,-0.14406E+01,-0.14420E+01, + &-0.14434E+01,-0.14448E+01,-0.14462E+01,-0.14476E+01,-0.14490E+01, + &-0.14504E+01,-0.14517E+01,-0.14531E+01,-0.14545E+01,-0.14559E+01, + &-0.14573E+01,-0.14586E+01,-0.14600E+01,-0.14614E+01,-0.14627E+01, + &-0.14641E+01,-0.14655E+01,-0.14668E+01,-0.14682E+01,-0.14696E+01, + &-0.14709E+01,-0.14723E+01,-0.14736E+01,-0.14750E+01,-0.14764E+01, + &-0.14777E+01,-0.14791E+01,-0.14804E+01,-0.14818E+01,-0.14831E+01, + &-0.14844E+01,-0.14858E+01,-0.14871E+01,-0.14885E+01,-0.14898E+01/ + + DATA (BNC05M (I),I=501,600)/ + &-0.14911E+01,-0.14925E+01,-0.14938E+01,-0.14951E+01,-0.14965E+01, + &-0.14978E+01,-0.14991E+01,-0.15005E+01,-0.15018E+01,-0.15031E+01, + &-0.15044E+01,-0.15057E+01,-0.15071E+01,-0.15084E+01,-0.15097E+01, + &-0.15110E+01,-0.15123E+01,-0.15136E+01,-0.15149E+01,-0.15162E+01, + &-0.15175E+01,-0.15188E+01,-0.15202E+01,-0.15215E+01,-0.15228E+01, + &-0.15241E+01,-0.15253E+01,-0.15266E+01,-0.15279E+01,-0.15292E+01, + &-0.15305E+01,-0.15318E+01,-0.15331E+01,-0.15344E+01,-0.15357E+01, + &-0.15370E+01,-0.15382E+01,-0.15395E+01,-0.15408E+01,-0.15421E+01, + &-0.15434E+01,-0.15446E+01,-0.15459E+01,-0.15472E+01,-0.15485E+01, + &-0.15497E+01,-0.15510E+01,-0.15523E+01,-0.15535E+01,-0.15548E+01, + &-0.15561E+01,-0.15573E+01,-0.15586E+01,-0.15598E+01,-0.15611E+01, + &-0.15624E+01,-0.15636E+01,-0.15649E+01,-0.15661E+01,-0.15674E+01, + &-0.15686E+01,-0.15699E+01,-0.15711E+01,-0.15724E+01,-0.15736E+01, + &-0.15749E+01,-0.15761E+01,-0.15773E+01,-0.15786E+01,-0.15798E+01, + &-0.15811E+01,-0.15823E+01,-0.15835E+01,-0.15848E+01,-0.15860E+01, + &-0.15872E+01,-0.15885E+01,-0.15897E+01,-0.15909E+01,-0.15922E+01, + &-0.15934E+01,-0.15946E+01,-0.15958E+01,-0.15971E+01,-0.15983E+01, + &-0.15995E+01,-0.16007E+01,-0.16019E+01,-0.16031E+01,-0.16044E+01, + &-0.16056E+01,-0.16068E+01,-0.16080E+01,-0.16092E+01,-0.16104E+01, + &-0.16116E+01,-0.16128E+01,-0.16140E+01,-0.16152E+01,-0.16198E+01/ + + DATA (BNC05M (I),I=601,700)/ + &-0.16296E+01,-0.16415E+01,-0.16532E+01,-0.16649E+01,-0.16764E+01, + &-0.16878E+01,-0.16992E+01,-0.17104E+01,-0.17216E+01,-0.17327E+01, + &-0.17437E+01,-0.17546E+01,-0.17654E+01,-0.17761E+01,-0.17868E+01, + &-0.17974E+01,-0.18079E+01,-0.18184E+01,-0.18287E+01,-0.18391E+01, + &-0.18493E+01,-0.18595E+01,-0.18696E+01,-0.18796E+01,-0.18896E+01, + &-0.18996E+01,-0.19094E+01,-0.19193E+01,-0.19290E+01,-0.19387E+01, + &-0.19484E+01,-0.19580E+01,-0.19675E+01,-0.19770E+01,-0.19865E+01, + &-0.19959E+01,-0.20053E+01,-0.20146E+01,-0.20238E+01,-0.20331E+01, + &-0.20423E+01,-0.20514E+01,-0.20605E+01,-0.20695E+01,-0.20786E+01, + &-0.20875E+01,-0.20965E+01,-0.21054E+01,-0.21143E+01,-0.21231E+01, + &-0.21319E+01,-0.21407E+01,-0.21494E+01,-0.21581E+01,-0.21667E+01, + &-0.21754E+01,-0.21840E+01,-0.21925E+01,-0.22011E+01,-0.22096E+01, + &-0.22180E+01,-0.22265E+01,-0.22349E+01,-0.22433E+01,-0.22517E+01, + &-0.22600E+01,-0.22683E+01,-0.22766E+01,-0.22848E+01,-0.22931E+01, + &-0.23013E+01,-0.23095E+01,-0.23176E+01,-0.23257E+01,-0.23338E+01, + &-0.23419E+01,-0.23500E+01,-0.23580E+01,-0.23661E+01,-0.23741E+01, + &-0.23820E+01,-0.23900E+01,-0.23979E+01,-0.24058E+01,-0.24137E+01, + &-0.24216E+01,-0.24294E+01,-0.24373E+01,-0.24451E+01,-0.24529E+01, + &-0.24607E+01,-0.24684E+01,-0.24762E+01,-0.24839E+01,-0.24916E+01, + &-0.24993E+01,-0.25070E+01,-0.25146E+01,-0.25222E+01,-0.25299E+01/ + + DATA (BNC05M(I),I=701,741)/ + &-0.25375E+01,-0.25451E+01,-0.25526E+01,-0.25602E+01,-0.25677E+01, + &-0.25753E+01,-0.25828E+01,-0.25903E+01,-0.25978E+01,-0.26052E+01, + &-0.26127E+01,-0.26201E+01,-0.26276E+01,-0.26350E+01,-0.26424E+01, + &-0.26498E+01,-0.26571E+01,-0.26645E+01,-0.26718E+01,-0.26792E+01, + &-0.26865E+01,-0.26938E+01,-0.27011E+01,-0.27084E+01,-0.27157E+01, + &-0.27229E+01,-0.27302E+01,-0.27374E+01,-0.27446E+01,-0.27519E+01, + &-0.27591E+01,-0.27663E+01,-0.27734E+01,-0.27806E+01,-0.27878E+01, + &-0.27949E+01,-0.28021E+01,-0.28092E+01,-0.28163E+01,-0.28234E+01, + &-0.28305E+01 + & / +C +C *** NH4Cl +C + DATA (BNC06M (I),I= 1,100)/ + &-0.55953E-01,-0.10077E+00,-0.13146E+00,-0.15183E+00,-0.16717E+00, + &-0.17947E+00,-0.18969E+00,-0.19842E+00,-0.20600E+00,-0.21268E+00, + &-0.21863E+00,-0.22398E+00,-0.22882E+00,-0.23322E+00,-0.23726E+00, + &-0.24097E+00,-0.24440E+00,-0.24758E+00,-0.25054E+00,-0.25330E+00, + &-0.25588E+00,-0.25830E+00,-0.26057E+00,-0.26271E+00,-0.26473E+00, + &-0.26663E+00,-0.26844E+00,-0.27015E+00,-0.27178E+00,-0.27333E+00, + &-0.27480E+00,-0.27621E+00,-0.27756E+00,-0.27885E+00,-0.28008E+00, + &-0.28126E+00,-0.28240E+00,-0.28349E+00,-0.28455E+00,-0.28556E+00, + &-0.28654E+00,-0.28749E+00,-0.28840E+00,-0.28929E+00,-0.29015E+00, + &-0.29098E+00,-0.29179E+00,-0.29258E+00,-0.29334E+00,-0.29409E+00, + &-0.29482E+00,-0.29552E+00,-0.29621E+00,-0.29689E+00,-0.29754E+00, + &-0.29819E+00,-0.29881E+00,-0.29943E+00,-0.30003E+00,-0.30061E+00, + &-0.30118E+00,-0.30174E+00,-0.30229E+00,-0.30283E+00,-0.30335E+00, + &-0.30386E+00,-0.30436E+00,-0.30484E+00,-0.30532E+00,-0.30578E+00, + &-0.30623E+00,-0.30667E+00,-0.30710E+00,-0.30751E+00,-0.30791E+00, + &-0.30830E+00,-0.30868E+00,-0.30905E+00,-0.30941E+00,-0.30975E+00, + &-0.31008E+00,-0.31040E+00,-0.31071E+00,-0.31100E+00,-0.31129E+00, + &-0.31156E+00,-0.31182E+00,-0.31207E+00,-0.31230E+00,-0.31253E+00, + &-0.31274E+00,-0.31295E+00,-0.31314E+00,-0.31332E+00,-0.31349E+00, + &-0.31365E+00,-0.31380E+00,-0.31394E+00,-0.31407E+00,-0.31420E+00/ + + DATA (BNC06M (I),I=101,200)/ + &-0.31431E+00,-0.31441E+00,-0.31451E+00,-0.31459E+00,-0.31467E+00, + &-0.31474E+00,-0.31480E+00,-0.31486E+00,-0.31491E+00,-0.31495E+00, + &-0.31499E+00,-0.31502E+00,-0.31504E+00,-0.31506E+00,-0.31508E+00, + &-0.31508E+00,-0.31509E+00,-0.31509E+00,-0.31508E+00,-0.31507E+00, + &-0.31518E+00,-0.31515E+00,-0.31512E+00,-0.31508E+00,-0.31505E+00, + &-0.31501E+00,-0.31497E+00,-0.31493E+00,-0.31488E+00,-0.31484E+00, + &-0.31479E+00,-0.31474E+00,-0.31470E+00,-0.31464E+00,-0.31459E+00, + &-0.31454E+00,-0.31449E+00,-0.31443E+00,-0.31437E+00,-0.31432E+00, + &-0.31426E+00,-0.31420E+00,-0.31414E+00,-0.31407E+00,-0.31401E+00, + &-0.31395E+00,-0.31389E+00,-0.31382E+00,-0.31375E+00,-0.31369E+00, + &-0.31362E+00,-0.31355E+00,-0.31349E+00,-0.31342E+00,-0.31335E+00, + &-0.31328E+00,-0.31321E+00,-0.31314E+00,-0.31307E+00,-0.31300E+00, + &-0.31293E+00,-0.31285E+00,-0.31278E+00,-0.31271E+00,-0.31264E+00, + &-0.31257E+00,-0.31249E+00,-0.31242E+00,-0.31235E+00,-0.31227E+00, + &-0.31220E+00,-0.31213E+00,-0.31205E+00,-0.31198E+00,-0.31190E+00, + &-0.31183E+00,-0.31176E+00,-0.31168E+00,-0.31161E+00,-0.31154E+00, + &-0.31146E+00,-0.31139E+00,-0.31132E+00,-0.31124E+00,-0.31117E+00, + &-0.31110E+00,-0.31102E+00,-0.31095E+00,-0.31088E+00,-0.31081E+00, + &-0.31073E+00,-0.31066E+00,-0.31059E+00,-0.31052E+00,-0.31045E+00, + &-0.31038E+00,-0.31031E+00,-0.31024E+00,-0.31017E+00,-0.31010E+00/ + + DATA (BNC06M (I),I=201,300)/ + &-0.31003E+00,-0.30996E+00,-0.30989E+00,-0.30982E+00,-0.30975E+00, + &-0.30969E+00,-0.30962E+00,-0.30955E+00,-0.30949E+00,-0.30942E+00, + &-0.30935E+00,-0.30929E+00,-0.30922E+00,-0.30916E+00,-0.30910E+00, + &-0.30903E+00,-0.30897E+00,-0.30891E+00,-0.30884E+00,-0.30878E+00, + &-0.30872E+00,-0.30866E+00,-0.30860E+00,-0.30854E+00,-0.30848E+00, + &-0.30842E+00,-0.30837E+00,-0.30831E+00,-0.30825E+00,-0.30819E+00, + &-0.30814E+00,-0.30808E+00,-0.30803E+00,-0.30797E+00,-0.30792E+00, + &-0.30787E+00,-0.30781E+00,-0.30776E+00,-0.30771E+00,-0.30766E+00, + &-0.30761E+00,-0.30756E+00,-0.30751E+00,-0.30746E+00,-0.30741E+00, + &-0.30737E+00,-0.30732E+00,-0.30727E+00,-0.30723E+00,-0.30718E+00, + &-0.30714E+00,-0.30709E+00,-0.30705E+00,-0.30701E+00,-0.30697E+00, + &-0.30692E+00,-0.30688E+00,-0.30684E+00,-0.30680E+00,-0.30676E+00, + &-0.30673E+00,-0.30669E+00,-0.30665E+00,-0.30662E+00,-0.30658E+00, + &-0.30654E+00,-0.30651E+00,-0.30648E+00,-0.30644E+00,-0.30641E+00, + &-0.30638E+00,-0.30635E+00,-0.30632E+00,-0.30629E+00,-0.30626E+00, + &-0.30623E+00,-0.30620E+00,-0.30617E+00,-0.30615E+00,-0.30612E+00, + &-0.30610E+00,-0.30607E+00,-0.30605E+00,-0.30602E+00,-0.30600E+00, + &-0.30598E+00,-0.30596E+00,-0.30594E+00,-0.30592E+00,-0.30590E+00, + &-0.30588E+00,-0.30586E+00,-0.30584E+00,-0.30583E+00,-0.30581E+00, + &-0.30580E+00,-0.30578E+00,-0.30577E+00,-0.30576E+00,-0.30574E+00/ + + DATA (BNC06M (I),I=301,400)/ + &-0.30573E+00,-0.30572E+00,-0.30571E+00,-0.30570E+00,-0.30569E+00, + &-0.30568E+00,-0.30567E+00,-0.30567E+00,-0.30566E+00,-0.30565E+00, + &-0.30565E+00,-0.30564E+00,-0.30564E+00,-0.30564E+00,-0.30564E+00, + &-0.30563E+00,-0.30563E+00,-0.30563E+00,-0.30563E+00,-0.30563E+00, + &-0.30563E+00,-0.30564E+00,-0.30564E+00,-0.30564E+00,-0.30565E+00, + &-0.30565E+00,-0.30566E+00,-0.30567E+00,-0.30567E+00,-0.30568E+00, + &-0.30569E+00,-0.30570E+00,-0.30571E+00,-0.30572E+00,-0.30573E+00, + &-0.30574E+00,-0.30575E+00,-0.30577E+00,-0.30578E+00,-0.30579E+00, + &-0.30581E+00,-0.30582E+00,-0.30584E+00,-0.30586E+00,-0.30588E+00, + &-0.30589E+00,-0.30591E+00,-0.30593E+00,-0.30595E+00,-0.30597E+00, + &-0.30600E+00,-0.30602E+00,-0.30604E+00,-0.30606E+00,-0.30609E+00, + &-0.30611E+00,-0.30614E+00,-0.30617E+00,-0.30619E+00,-0.30622E+00, + &-0.30625E+00,-0.30628E+00,-0.30631E+00,-0.30634E+00,-0.30637E+00, + &-0.30640E+00,-0.30643E+00,-0.30646E+00,-0.30650E+00,-0.30653E+00, + &-0.30657E+00,-0.30660E+00,-0.30664E+00,-0.30667E+00,-0.30671E+00, + &-0.30675E+00,-0.30679E+00,-0.30683E+00,-0.30687E+00,-0.30691E+00, + &-0.30695E+00,-0.30699E+00,-0.30703E+00,-0.30708E+00,-0.30712E+00, + &-0.30716E+00,-0.30721E+00,-0.30726E+00,-0.30730E+00,-0.30735E+00, + &-0.30740E+00,-0.30744E+00,-0.30749E+00,-0.30754E+00,-0.30759E+00, + &-0.30764E+00,-0.30769E+00,-0.30775E+00,-0.30780E+00,-0.30785E+00/ + + DATA (BNC06M (I),I=401,500)/ + &-0.30791E+00,-0.30796E+00,-0.30802E+00,-0.30807E+00,-0.30813E+00, + &-0.30818E+00,-0.30824E+00,-0.30830E+00,-0.30836E+00,-0.30842E+00, + &-0.30848E+00,-0.30854E+00,-0.30860E+00,-0.30866E+00,-0.30872E+00, + &-0.30879E+00,-0.30885E+00,-0.30891E+00,-0.30898E+00,-0.30904E+00, + &-0.30911E+00,-0.30918E+00,-0.30924E+00,-0.30931E+00,-0.30938E+00, + &-0.30945E+00,-0.30952E+00,-0.30959E+00,-0.30966E+00,-0.30973E+00, + &-0.30980E+00,-0.30987E+00,-0.30995E+00,-0.31002E+00,-0.31010E+00, + &-0.31017E+00,-0.31025E+00,-0.31032E+00,-0.31040E+00,-0.31048E+00, + &-0.31055E+00,-0.31063E+00,-0.31071E+00,-0.31079E+00,-0.31087E+00, + &-0.31095E+00,-0.31103E+00,-0.31111E+00,-0.31120E+00,-0.31128E+00, + &-0.31136E+00,-0.31145E+00,-0.31153E+00,-0.31162E+00,-0.31170E+00, + &-0.31179E+00,-0.31188E+00,-0.31196E+00,-0.31205E+00,-0.31214E+00, + &-0.31223E+00,-0.31232E+00,-0.31241E+00,-0.31250E+00,-0.31259E+00, + &-0.31268E+00,-0.31278E+00,-0.31287E+00,-0.31296E+00,-0.31306E+00, + &-0.31315E+00,-0.31325E+00,-0.31334E+00,-0.31344E+00,-0.31354E+00, + &-0.31363E+00,-0.31373E+00,-0.31383E+00,-0.31393E+00,-0.31403E+00, + &-0.31413E+00,-0.31423E+00,-0.31433E+00,-0.31443E+00,-0.31454E+00, + &-0.31464E+00,-0.31474E+00,-0.31485E+00,-0.31495E+00,-0.31506E+00, + &-0.31516E+00,-0.31527E+00,-0.31537E+00,-0.31548E+00,-0.31559E+00, + &-0.31570E+00,-0.31581E+00,-0.31591E+00,-0.31602E+00,-0.31613E+00/ + + DATA (BNC06M (I),I=501,600)/ + &-0.31625E+00,-0.31636E+00,-0.31647E+00,-0.31658E+00,-0.31669E+00, + &-0.31681E+00,-0.31692E+00,-0.31704E+00,-0.31715E+00,-0.31727E+00, + &-0.31738E+00,-0.31750E+00,-0.31761E+00,-0.31773E+00,-0.31785E+00, + &-0.31797E+00,-0.31809E+00,-0.31821E+00,-0.31833E+00,-0.31845E+00, + &-0.31857E+00,-0.31869E+00,-0.31881E+00,-0.31893E+00,-0.31906E+00, + &-0.31918E+00,-0.31931E+00,-0.31943E+00,-0.31955E+00,-0.31968E+00, + &-0.31981E+00,-0.31993E+00,-0.32006E+00,-0.32019E+00,-0.32032E+00, + &-0.32044E+00,-0.32057E+00,-0.32070E+00,-0.32083E+00,-0.32096E+00, + &-0.32109E+00,-0.32122E+00,-0.32136E+00,-0.32149E+00,-0.32162E+00, + &-0.32175E+00,-0.32189E+00,-0.32202E+00,-0.32216E+00,-0.32229E+00, + &-0.32243E+00,-0.32256E+00,-0.32270E+00,-0.32284E+00,-0.32298E+00, + &-0.32311E+00,-0.32325E+00,-0.32339E+00,-0.32353E+00,-0.32367E+00, + &-0.32381E+00,-0.32395E+00,-0.32409E+00,-0.32423E+00,-0.32438E+00, + &-0.32452E+00,-0.32466E+00,-0.32481E+00,-0.32495E+00,-0.32509E+00, + &-0.32524E+00,-0.32538E+00,-0.32553E+00,-0.32568E+00,-0.32582E+00, + &-0.32597E+00,-0.32612E+00,-0.32627E+00,-0.32642E+00,-0.32656E+00, + &-0.32671E+00,-0.32686E+00,-0.32701E+00,-0.32716E+00,-0.32732E+00, + &-0.32747E+00,-0.32762E+00,-0.32777E+00,-0.32793E+00,-0.32808E+00, + &-0.32823E+00,-0.32839E+00,-0.32854E+00,-0.32870E+00,-0.32885E+00, + &-0.32901E+00,-0.32917E+00,-0.32932E+00,-0.32948E+00,-0.33007E+00/ + + DATA (BNC06M (I),I=601,700)/ + &-0.33140E+00,-0.33305E+00,-0.33474E+00,-0.33647E+00,-0.33824E+00, + &-0.34005E+00,-0.34190E+00,-0.34379E+00,-0.34571E+00,-0.34767E+00, + &-0.34966E+00,-0.35169E+00,-0.35376E+00,-0.35586E+00,-0.35799E+00, + &-0.36016E+00,-0.36235E+00,-0.36458E+00,-0.36684E+00,-0.36913E+00, + &-0.37146E+00,-0.37381E+00,-0.37619E+00,-0.37859E+00,-0.38103E+00, + &-0.38349E+00,-0.38598E+00,-0.38850E+00,-0.39105E+00,-0.39361E+00, + &-0.39621E+00,-0.39883E+00,-0.40147E+00,-0.40414E+00,-0.40684E+00, + &-0.40955E+00,-0.41229E+00,-0.41506E+00,-0.41784E+00,-0.42065E+00, + &-0.42348E+00,-0.42633E+00,-0.42920E+00,-0.43209E+00,-0.43500E+00, + &-0.43793E+00,-0.44089E+00,-0.44386E+00,-0.44685E+00,-0.44986E+00, + &-0.45289E+00,-0.45594E+00,-0.45901E+00,-0.46209E+00,-0.46519E+00, + &-0.46831E+00,-0.47145E+00,-0.47460E+00,-0.47777E+00,-0.48096E+00, + &-0.48416E+00,-0.48738E+00,-0.49062E+00,-0.49387E+00,-0.49713E+00, + &-0.50042E+00,-0.50371E+00,-0.50702E+00,-0.51035E+00,-0.51369E+00, + &-0.51705E+00,-0.52042E+00,-0.52380E+00,-0.52720E+00,-0.53061E+00, + &-0.53403E+00,-0.53747E+00,-0.54092E+00,-0.54438E+00,-0.54786E+00, + &-0.55135E+00,-0.55485E+00,-0.55836E+00,-0.56189E+00,-0.56543E+00, + &-0.56898E+00,-0.57254E+00,-0.57611E+00,-0.57970E+00,-0.58329E+00, + &-0.58690E+00,-0.59052E+00,-0.59415E+00,-0.59779E+00,-0.60144E+00, + &-0.60510E+00,-0.60877E+00,-0.61245E+00,-0.61614E+00,-0.61985E+00/ + + DATA (BNC06M(I),I=701,741)/ + &-0.62356E+00,-0.62728E+00,-0.63101E+00,-0.63475E+00,-0.63851E+00, + &-0.64227E+00,-0.64604E+00,-0.64982E+00,-0.65360E+00,-0.65740E+00, + &-0.66121E+00,-0.66502E+00,-0.66885E+00,-0.67268E+00,-0.67652E+00, + &-0.68037E+00,-0.68423E+00,-0.68809E+00,-0.69197E+00,-0.69585E+00, + &-0.69974E+00,-0.70364E+00,-0.70755E+00,-0.71146E+00,-0.71539E+00, + &-0.71932E+00,-0.72325E+00,-0.72720E+00,-0.73115E+00,-0.73511E+00, + &-0.73908E+00,-0.74305E+00,-0.74703E+00,-0.75102E+00,-0.75502E+00, + &-0.75902E+00,-0.76303E+00,-0.76705E+00,-0.77107E+00,-0.77510E+00, + &-0.77914E+00 + & / +C +C *** (2H, SO4) +C + DATA (BNC07M (I),I= 1,100)/ + &-0.11374E+00,-0.20831E+00,-0.27574E+00,-0.32220E+00,-0.35838E+00, + &-0.38830E+00,-0.41395E+00,-0.43649E+00,-0.45665E+00,-0.47492E+00, + &-0.49165E+00,-0.50711E+00,-0.52150E+00,-0.53497E+00,-0.54765E+00, + &-0.55962E+00,-0.57099E+00,-0.58180E+00,-0.59213E+00,-0.60201E+00, + &-0.61150E+00,-0.62062E+00,-0.62941E+00,-0.63790E+00,-0.64610E+00, + &-0.65405E+00,-0.66175E+00,-0.66923E+00,-0.67651E+00,-0.68359E+00, + &-0.69048E+00,-0.69721E+00,-0.70377E+00,-0.71018E+00,-0.71645E+00, + &-0.72258E+00,-0.72859E+00,-0.73447E+00,-0.74024E+00,-0.74589E+00, + &-0.75145E+00,-0.75690E+00,-0.76225E+00,-0.76752E+00,-0.77270E+00, + &-0.77779E+00,-0.78281E+00,-0.78774E+00,-0.79261E+00,-0.79740E+00, + &-0.80212E+00,-0.80678E+00,-0.81138E+00,-0.81592E+00,-0.82039E+00, + &-0.82481E+00,-0.82918E+00,-0.83349E+00,-0.83776E+00,-0.84197E+00, + &-0.84614E+00,-0.85026E+00,-0.85434E+00,-0.85837E+00,-0.86237E+00, + &-0.86632E+00,-0.87023E+00,-0.87411E+00,-0.87795E+00,-0.88176E+00, + &-0.88553E+00,-0.88927E+00,-0.89297E+00,-0.89665E+00,-0.90029E+00, + &-0.90391E+00,-0.90750E+00,-0.91106E+00,-0.91459E+00,-0.91810E+00, + &-0.92158E+00,-0.92503E+00,-0.92847E+00,-0.93188E+00,-0.93527E+00, + &-0.93863E+00,-0.94197E+00,-0.94530E+00,-0.94860E+00,-0.95188E+00, + &-0.95514E+00,-0.95839E+00,-0.96161E+00,-0.96482E+00,-0.96801E+00, + &-0.97118E+00,-0.97433E+00,-0.97747E+00,-0.98059E+00,-0.98370E+00/ + + DATA (BNC07M (I),I=101,200)/ + &-0.98679E+00,-0.98986E+00,-0.99292E+00,-0.99596E+00,-0.99899E+00, + &-0.10020E+01,-0.10050E+01,-0.10080E+01,-0.10110E+01,-0.10139E+01, + &-0.10169E+01,-0.10198E+01,-0.10227E+01,-0.10256E+01,-0.10285E+01, + &-0.10314E+01,-0.10343E+01,-0.10371E+01,-0.10400E+01,-0.10428E+01, + &-0.10456E+01,-0.10484E+01,-0.10512E+01,-0.10540E+01,-0.10568E+01, + &-0.10596E+01,-0.10623E+01,-0.10651E+01,-0.10678E+01,-0.10706E+01, + &-0.10733E+01,-0.10760E+01,-0.10787E+01,-0.10814E+01,-0.10840E+01, + &-0.10867E+01,-0.10894E+01,-0.10920E+01,-0.10947E+01,-0.10973E+01, + &-0.10999E+01,-0.11025E+01,-0.11051E+01,-0.11077E+01,-0.11103E+01, + &-0.11129E+01,-0.11155E+01,-0.11180E+01,-0.11206E+01,-0.11232E+01, + &-0.11257E+01,-0.11282E+01,-0.11308E+01,-0.11333E+01,-0.11358E+01, + &-0.11383E+01,-0.11408E+01,-0.11433E+01,-0.11458E+01,-0.11482E+01, + &-0.11507E+01,-0.11532E+01,-0.11556E+01,-0.11581E+01,-0.11605E+01, + &-0.11629E+01,-0.11654E+01,-0.11678E+01,-0.11702E+01,-0.11726E+01, + &-0.11750E+01,-0.11774E+01,-0.11798E+01,-0.11822E+01,-0.11846E+01, + &-0.11870E+01,-0.11893E+01,-0.11917E+01,-0.11941E+01,-0.11964E+01, + &-0.11988E+01,-0.12011E+01,-0.12034E+01,-0.12058E+01,-0.12081E+01, + &-0.12104E+01,-0.12127E+01,-0.12150E+01,-0.12173E+01,-0.12196E+01, + &-0.12219E+01,-0.12242E+01,-0.12265E+01,-0.12288E+01,-0.12311E+01, + &-0.12333E+01,-0.12356E+01,-0.12379E+01,-0.12401E+01,-0.12424E+01/ + + DATA (BNC07M (I),I=201,300)/ + &-0.12446E+01,-0.12469E+01,-0.12491E+01,-0.12514E+01,-0.12536E+01, + &-0.12558E+01,-0.12580E+01,-0.12603E+01,-0.12625E+01,-0.12647E+01, + &-0.12669E+01,-0.12691E+01,-0.12713E+01,-0.12735E+01,-0.12757E+01, + &-0.12779E+01,-0.12800E+01,-0.12822E+01,-0.12844E+01,-0.12866E+01, + &-0.12887E+01,-0.12909E+01,-0.12930E+01,-0.12952E+01,-0.12974E+01, + &-0.12995E+01,-0.13017E+01,-0.13038E+01,-0.13059E+01,-0.13081E+01, + &-0.13102E+01,-0.13123E+01,-0.13144E+01,-0.13166E+01,-0.13187E+01, + &-0.13208E+01,-0.13229E+01,-0.13250E+01,-0.13271E+01,-0.13292E+01, + &-0.13313E+01,-0.13334E+01,-0.13355E+01,-0.13376E+01,-0.13397E+01, + &-0.13418E+01,-0.13438E+01,-0.13459E+01,-0.13480E+01,-0.13501E+01, + &-0.13521E+01,-0.13542E+01,-0.13563E+01,-0.13583E+01,-0.13604E+01, + &-0.13624E+01,-0.13645E+01,-0.13665E+01,-0.13686E+01,-0.13706E+01, + &-0.13727E+01,-0.13747E+01,-0.13767E+01,-0.13788E+01,-0.13808E+01, + &-0.13828E+01,-0.13848E+01,-0.13869E+01,-0.13889E+01,-0.13909E+01, + &-0.13929E+01,-0.13949E+01,-0.13969E+01,-0.13989E+01,-0.14009E+01, + &-0.14029E+01,-0.14049E+01,-0.14069E+01,-0.14089E+01,-0.14109E+01, + &-0.14129E+01,-0.14149E+01,-0.14169E+01,-0.14188E+01,-0.14208E+01, + &-0.14228E+01,-0.14248E+01,-0.14267E+01,-0.14287E+01,-0.14307E+01, + &-0.14326E+01,-0.14346E+01,-0.14366E+01,-0.14385E+01,-0.14405E+01, + &-0.14424E+01,-0.14444E+01,-0.14463E+01,-0.14483E+01,-0.14502E+01/ + + DATA (BNC07M (I),I=301,400)/ + &-0.14522E+01,-0.14541E+01,-0.14561E+01,-0.14580E+01,-0.14599E+01, + &-0.14619E+01,-0.14638E+01,-0.14657E+01,-0.14676E+01,-0.14696E+01, + &-0.14715E+01,-0.14734E+01,-0.14753E+01,-0.14772E+01,-0.14792E+01, + &-0.14811E+01,-0.14830E+01,-0.14849E+01,-0.14868E+01,-0.14887E+01, + &-0.14906E+01,-0.14925E+01,-0.14944E+01,-0.14963E+01,-0.14982E+01, + &-0.15001E+01,-0.15020E+01,-0.15039E+01,-0.15058E+01,-0.15077E+01, + &-0.15095E+01,-0.15114E+01,-0.15133E+01,-0.15152E+01,-0.15171E+01, + &-0.15189E+01,-0.15208E+01,-0.15227E+01,-0.15246E+01,-0.15264E+01, + &-0.15283E+01,-0.15302E+01,-0.15320E+01,-0.15339E+01,-0.15358E+01, + &-0.15376E+01,-0.15395E+01,-0.15413E+01,-0.15432E+01,-0.15450E+01, + &-0.15469E+01,-0.15487E+01,-0.15506E+01,-0.15524E+01,-0.15543E+01, + &-0.15561E+01,-0.15580E+01,-0.15598E+01,-0.15617E+01,-0.15635E+01, + &-0.15653E+01,-0.15672E+01,-0.15690E+01,-0.15708E+01,-0.15727E+01, + &-0.15745E+01,-0.15763E+01,-0.15781E+01,-0.15800E+01,-0.15818E+01, + &-0.15836E+01,-0.15854E+01,-0.15873E+01,-0.15891E+01,-0.15909E+01, + &-0.15927E+01,-0.15945E+01,-0.15963E+01,-0.15981E+01,-0.15999E+01, + &-0.16018E+01,-0.16036E+01,-0.16054E+01,-0.16072E+01,-0.16090E+01, + &-0.16108E+01,-0.16126E+01,-0.16144E+01,-0.16162E+01,-0.16180E+01, + &-0.16198E+01,-0.16216E+01,-0.16233E+01,-0.16251E+01,-0.16269E+01, + &-0.16287E+01,-0.16305E+01,-0.16323E+01,-0.16341E+01,-0.16358E+01/ + + DATA (BNC07M (I),I=401,500)/ + &-0.16376E+01,-0.16394E+01,-0.16412E+01,-0.16430E+01,-0.16447E+01, + &-0.16465E+01,-0.16483E+01,-0.16501E+01,-0.16518E+01,-0.16536E+01, + &-0.16554E+01,-0.16571E+01,-0.16589E+01,-0.16607E+01,-0.16624E+01, + &-0.16642E+01,-0.16660E+01,-0.16677E+01,-0.16695E+01,-0.16712E+01, + &-0.16730E+01,-0.16748E+01,-0.16765E+01,-0.16783E+01,-0.16800E+01, + &-0.16818E+01,-0.16835E+01,-0.16853E+01,-0.16870E+01,-0.16888E+01, + &-0.16905E+01,-0.16923E+01,-0.16940E+01,-0.16958E+01,-0.16975E+01, + &-0.16992E+01,-0.17010E+01,-0.17027E+01,-0.17045E+01,-0.17062E+01, + &-0.17079E+01,-0.17097E+01,-0.17114E+01,-0.17131E+01,-0.17149E+01, + &-0.17166E+01,-0.17183E+01,-0.17200E+01,-0.17218E+01,-0.17235E+01, + &-0.17252E+01,-0.17270E+01,-0.17287E+01,-0.17304E+01,-0.17321E+01, + &-0.17338E+01,-0.17356E+01,-0.17373E+01,-0.17390E+01,-0.17407E+01, + &-0.17424E+01,-0.17441E+01,-0.17459E+01,-0.17476E+01,-0.17493E+01, + &-0.17510E+01,-0.17527E+01,-0.17544E+01,-0.17561E+01,-0.17578E+01, + &-0.17595E+01,-0.17612E+01,-0.17629E+01,-0.17646E+01,-0.17663E+01, + &-0.17680E+01,-0.17697E+01,-0.17714E+01,-0.17731E+01,-0.17748E+01, + &-0.17765E+01,-0.17782E+01,-0.17799E+01,-0.17816E+01,-0.17833E+01, + &-0.17850E+01,-0.17867E+01,-0.17884E+01,-0.17901E+01,-0.17918E+01, + &-0.17935E+01,-0.17951E+01,-0.17968E+01,-0.17985E+01,-0.18002E+01, + &-0.18019E+01,-0.18036E+01,-0.18052E+01,-0.18069E+01,-0.18086E+01/ + + DATA (BNC07M (I),I=501,600)/ + &-0.18103E+01,-0.18120E+01,-0.18136E+01,-0.18153E+01,-0.18170E+01, + &-0.18187E+01,-0.18203E+01,-0.18220E+01,-0.18237E+01,-0.18254E+01, + &-0.18270E+01,-0.18287E+01,-0.18304E+01,-0.18320E+01,-0.18337E+01, + &-0.18354E+01,-0.18370E+01,-0.18387E+01,-0.18404E+01,-0.18420E+01, + &-0.18437E+01,-0.18454E+01,-0.18470E+01,-0.18487E+01,-0.18503E+01, + &-0.18520E+01,-0.18537E+01,-0.18553E+01,-0.18570E+01,-0.18586E+01, + &-0.18603E+01,-0.18619E+01,-0.18636E+01,-0.18653E+01,-0.18669E+01, + &-0.18686E+01,-0.18702E+01,-0.18719E+01,-0.18735E+01,-0.18752E+01, + &-0.18768E+01,-0.18785E+01,-0.18801E+01,-0.18817E+01,-0.18834E+01, + &-0.18850E+01,-0.18867E+01,-0.18883E+01,-0.18900E+01,-0.18916E+01, + &-0.18932E+01,-0.18949E+01,-0.18965E+01,-0.18982E+01,-0.18998E+01, + &-0.19014E+01,-0.19031E+01,-0.19047E+01,-0.19063E+01,-0.19080E+01, + &-0.19096E+01,-0.19112E+01,-0.19129E+01,-0.19145E+01,-0.19161E+01, + &-0.19178E+01,-0.19194E+01,-0.19210E+01,-0.19227E+01,-0.19243E+01, + &-0.19259E+01,-0.19275E+01,-0.19292E+01,-0.19308E+01,-0.19324E+01, + &-0.19340E+01,-0.19357E+01,-0.19373E+01,-0.19389E+01,-0.19405E+01, + &-0.19421E+01,-0.19438E+01,-0.19454E+01,-0.19470E+01,-0.19486E+01, + &-0.19502E+01,-0.19519E+01,-0.19535E+01,-0.19551E+01,-0.19567E+01, + &-0.19583E+01,-0.19599E+01,-0.19615E+01,-0.19632E+01,-0.19648E+01, + &-0.19664E+01,-0.19680E+01,-0.19696E+01,-0.19712E+01,-0.19772E+01/ + + DATA (BNC07M (I),I=601,700)/ + &-0.19905E+01,-0.20065E+01,-0.20224E+01,-0.20383E+01,-0.20541E+01, + &-0.20698E+01,-0.20856E+01,-0.21012E+01,-0.21168E+01,-0.21324E+01, + &-0.21479E+01,-0.21634E+01,-0.21788E+01,-0.21942E+01,-0.22096E+01, + &-0.22249E+01,-0.22401E+01,-0.22554E+01,-0.22705E+01,-0.22857E+01, + &-0.23008E+01,-0.23159E+01,-0.23309E+01,-0.23459E+01,-0.23609E+01, + &-0.23758E+01,-0.23907E+01,-0.24056E+01,-0.24204E+01,-0.24352E+01, + &-0.24500E+01,-0.24647E+01,-0.24795E+01,-0.24941E+01,-0.25088E+01, + &-0.25234E+01,-0.25380E+01,-0.25526E+01,-0.25672E+01,-0.25817E+01, + &-0.25962E+01,-0.26107E+01,-0.26251E+01,-0.26395E+01,-0.26539E+01, + &-0.26683E+01,-0.26827E+01,-0.26970E+01,-0.27113E+01,-0.27256E+01, + &-0.27399E+01,-0.27541E+01,-0.27683E+01,-0.27825E+01,-0.27967E+01, + &-0.28109E+01,-0.28250E+01,-0.28391E+01,-0.28532E+01,-0.28673E+01, + &-0.28814E+01,-0.28954E+01,-0.29094E+01,-0.29235E+01,-0.29374E+01, + &-0.29514E+01,-0.29654E+01,-0.29793E+01,-0.29932E+01,-0.30071E+01, + &-0.30210E+01,-0.30349E+01,-0.30487E+01,-0.30626E+01,-0.30764E+01, + &-0.30902E+01,-0.31040E+01,-0.31178E+01,-0.31315E+01,-0.31453E+01, + &-0.31590E+01,-0.31727E+01,-0.31864E+01,-0.32001E+01,-0.32138E+01, + &-0.32274E+01,-0.32411E+01,-0.32547E+01,-0.32683E+01,-0.32819E+01, + &-0.32955E+01,-0.33091E+01,-0.33226E+01,-0.33362E+01,-0.33497E+01, + &-0.33632E+01,-0.33767E+01,-0.33902E+01,-0.34037E+01,-0.34172E+01/ + + DATA (BNC07M(I),I=701,741)/ + &-0.34307E+01,-0.34441E+01,-0.34576E+01,-0.34710E+01,-0.34844E+01, + &-0.34978E+01,-0.35112E+01,-0.35246E+01,-0.35380E+01,-0.35513E+01, + &-0.35647E+01,-0.35780E+01,-0.35913E+01,-0.36046E+01,-0.36179E+01, + &-0.36312E+01,-0.36445E+01,-0.36578E+01,-0.36711E+01,-0.36843E+01, + &-0.36976E+01,-0.37108E+01,-0.37240E+01,-0.37372E+01,-0.37504E+01, + &-0.37636E+01,-0.37768E+01,-0.37900E+01,-0.38032E+01,-0.38163E+01, + &-0.38295E+01,-0.38426E+01,-0.38557E+01,-0.38689E+01,-0.38820E+01, + &-0.38951E+01,-0.39082E+01,-0.39213E+01,-0.39343E+01,-0.39474E+01, + &-0.39605E+01 + & / +C +C *** (H, HSO4) +C + DATA (BNC08M (I),I= 1,100)/ + &-0.51998E-01,-0.87278E-01,-0.10725E+00,-0.11796E+00,-0.12426E+00, + &-0.12788E+00,-0.12969E+00,-0.13016E+00,-0.12958E+00,-0.12816E+00, + &-0.12603E+00,-0.12329E+00,-0.12003E+00,-0.11630E+00,-0.11215E+00, + &-0.10761E+00,-0.10272E+00,-0.97512E-01,-0.91996E-01,-0.86196E-01, + &-0.80129E-01,-0.73810E-01,-0.67251E-01,-0.60465E-01,-0.53463E-01, + &-0.46254E-01,-0.38847E-01,-0.31251E-01,-0.23474E-01,-0.15524E-01, + &-0.74071E-02, 0.86952E-03, 0.92994E-02, 0.17876E-01, 0.26595E-01, + & 0.35448E-01, 0.44432E-01, 0.53541E-01, 0.62769E-01, 0.72112E-01, + & 0.81565E-01, 0.91123E-01, 0.10078E+00, 0.11054E+00, 0.12039E+00, + & 0.13032E+00, 0.14035E+00, 0.15045E+00, 0.16063E+00, 0.17089E+00, + & 0.18122E+00, 0.19162E+00, 0.20209E+00, 0.21262E+00, 0.22321E+00, + & 0.23386E+00, 0.24457E+00, 0.25534E+00, 0.26617E+00, 0.27704E+00, + & 0.28797E+00, 0.29896E+00, 0.30999E+00, 0.32108E+00, 0.33221E+00, + & 0.34340E+00, 0.35464E+00, 0.36593E+00, 0.37727E+00, 0.38867E+00, + & 0.40012E+00, 0.41162E+00, 0.42317E+00, 0.43478E+00, 0.44645E+00, + & 0.45817E+00, 0.46995E+00, 0.48179E+00, 0.49369E+00, 0.50566E+00, + & 0.51768E+00, 0.52976E+00, 0.54191E+00, 0.55412E+00, 0.56639E+00, + & 0.57873E+00, 0.59114E+00, 0.60360E+00, 0.61613E+00, 0.62873E+00, + & 0.64138E+00, 0.65410E+00, 0.66688E+00, 0.67973E+00, 0.69263E+00, + & 0.70559E+00, 0.71860E+00, 0.73167E+00, 0.74480E+00, 0.75797E+00/ + + DATA (BNC08M (I),I=101,200)/ + & 0.77120E+00, 0.78447E+00, 0.79778E+00, 0.81114E+00, 0.82454E+00, + & 0.83797E+00, 0.85144E+00, 0.86495E+00, 0.87848E+00, 0.89204E+00, + & 0.90562E+00, 0.91923E+00, 0.93286E+00, 0.94651E+00, 0.96017E+00, + & 0.97384E+00, 0.98753E+00, 0.10012E+01, 0.10149E+01, 0.10286E+01, + & 0.10411E+01, 0.10550E+01, 0.10688E+01, 0.10826E+01, 0.10964E+01, + & 0.11102E+01, 0.11240E+01, 0.11377E+01, 0.11514E+01, 0.11651E+01, + & 0.11788E+01, 0.11925E+01, 0.12061E+01, 0.12198E+01, 0.12334E+01, + & 0.12470E+01, 0.12605E+01, 0.12741E+01, 0.12876E+01, 0.13011E+01, + & 0.13145E+01, 0.13280E+01, 0.13414E+01, 0.13548E+01, 0.13682E+01, + & 0.13815E+01, 0.13949E+01, 0.14082E+01, 0.14214E+01, 0.14347E+01, + & 0.14479E+01, 0.14611E+01, 0.14743E+01, 0.14875E+01, 0.15006E+01, + & 0.15137E+01, 0.15267E+01, 0.15398E+01, 0.15528E+01, 0.15658E+01, + & 0.15788E+01, 0.15917E+01, 0.16046E+01, 0.16175E+01, 0.16304E+01, + & 0.16432E+01, 0.16560E+01, 0.16688E+01, 0.16815E+01, 0.16942E+01, + & 0.17069E+01, 0.17196E+01, 0.17322E+01, 0.17448E+01, 0.17574E+01, + & 0.17700E+01, 0.17825E+01, 0.17950E+01, 0.18075E+01, 0.18199E+01, + & 0.18324E+01, 0.18447E+01, 0.18571E+01, 0.18694E+01, 0.18818E+01, + & 0.18940E+01, 0.19063E+01, 0.19185E+01, 0.19307E+01, 0.19429E+01, + & 0.19550E+01, 0.19671E+01, 0.19792E+01, 0.19913E+01, 0.20033E+01, + & 0.20153E+01, 0.20273E+01, 0.20393E+01, 0.20512E+01, 0.20631E+01/ + + DATA (BNC08M (I),I=201,300)/ + & 0.20750E+01, 0.20868E+01, 0.20986E+01, 0.21104E+01, 0.21222E+01, + & 0.21339E+01, 0.21456E+01, 0.21573E+01, 0.21690E+01, 0.21806E+01, + & 0.21922E+01, 0.22038E+01, 0.22153E+01, 0.22269E+01, 0.22384E+01, + & 0.22498E+01, 0.22613E+01, 0.22727E+01, 0.22841E+01, 0.22955E+01, + & 0.23068E+01, 0.23181E+01, 0.23294E+01, 0.23407E+01, 0.23520E+01, + & 0.23632E+01, 0.23744E+01, 0.23855E+01, 0.23967E+01, 0.24078E+01, + & 0.24189E+01, 0.24299E+01, 0.24410E+01, 0.24520E+01, 0.24630E+01, + & 0.24740E+01, 0.24849E+01, 0.24958E+01, 0.25067E+01, 0.25176E+01, + & 0.25284E+01, 0.25393E+01, 0.25501E+01, 0.25608E+01, 0.25716E+01, + & 0.25823E+01, 0.25930E+01, 0.26037E+01, 0.26143E+01, 0.26250E+01, + & 0.26356E+01, 0.26462E+01, 0.26567E+01, 0.26673E+01, 0.26778E+01, + & 0.26883E+01, 0.26988E+01, 0.27092E+01, 0.27196E+01, 0.27300E+01, + & 0.27404E+01, 0.27508E+01, 0.27611E+01, 0.27714E+01, 0.27817E+01, + & 0.27920E+01, 0.28022E+01, 0.28124E+01, 0.28226E+01, 0.28328E+01, + & 0.28430E+01, 0.28531E+01, 0.28632E+01, 0.28733E+01, 0.28834E+01, + & 0.28934E+01, 0.29034E+01, 0.29134E+01, 0.29234E+01, 0.29334E+01, + & 0.29433E+01, 0.29533E+01, 0.29632E+01, 0.29730E+01, 0.29829E+01, + & 0.29927E+01, 0.30026E+01, 0.30123E+01, 0.30221E+01, 0.30319E+01, + & 0.30416E+01, 0.30513E+01, 0.30610E+01, 0.30707E+01, 0.30804E+01, + & 0.30900E+01, 0.30996E+01, 0.31092E+01, 0.31188E+01, 0.31283E+01/ + + DATA (BNC08M (I),I=301,400)/ + & 0.31379E+01, 0.31474E+01, 0.31569E+01, 0.31663E+01, 0.31758E+01, + & 0.31852E+01, 0.31947E+01, 0.32041E+01, 0.32134E+01, 0.32228E+01, + & 0.32321E+01, 0.32415E+01, 0.32508E+01, 0.32601E+01, 0.32693E+01, + & 0.32786E+01, 0.32878E+01, 0.32970E+01, 0.33062E+01, 0.33154E+01, + & 0.33245E+01, 0.33337E+01, 0.33428E+01, 0.33519E+01, 0.33610E+01, + & 0.33701E+01, 0.33791E+01, 0.33881E+01, 0.33971E+01, 0.34061E+01, + & 0.34151E+01, 0.34241E+01, 0.34330E+01, 0.34419E+01, 0.34508E+01, + & 0.34597E+01, 0.34686E+01, 0.34775E+01, 0.34863E+01, 0.34951E+01, + & 0.35039E+01, 0.35127E+01, 0.35215E+01, 0.35302E+01, 0.35390E+01, + & 0.35477E+01, 0.35564E+01, 0.35651E+01, 0.35737E+01, 0.35824E+01, + & 0.35910E+01, 0.35996E+01, 0.36083E+01, 0.36168E+01, 0.36254E+01, + & 0.36340E+01, 0.36425E+01, 0.36510E+01, 0.36595E+01, 0.36680E+01, + & 0.36765E+01, 0.36850E+01, 0.36934E+01, 0.37018E+01, 0.37102E+01, + & 0.37186E+01, 0.37270E+01, 0.37354E+01, 0.37437E+01, 0.37521E+01, + & 0.37604E+01, 0.37687E+01, 0.37770E+01, 0.37852E+01, 0.37935E+01, + & 0.38017E+01, 0.38100E+01, 0.38182E+01, 0.38264E+01, 0.38345E+01, + & 0.38427E+01, 0.38509E+01, 0.38590E+01, 0.38671E+01, 0.38752E+01, + & 0.38833E+01, 0.38914E+01, 0.38995E+01, 0.39075E+01, 0.39155E+01, + & 0.39236E+01, 0.39316E+01, 0.39396E+01, 0.39475E+01, 0.39555E+01, + & 0.39634E+01, 0.39714E+01, 0.39793E+01, 0.39872E+01, 0.39951E+01/ + + DATA (BNC08M (I),I=401,500)/ + & 0.40030E+01, 0.40108E+01, 0.40187E+01, 0.40265E+01, 0.40343E+01, + & 0.40421E+01, 0.40499E+01, 0.40577E+01, 0.40655E+01, 0.40732E+01, + & 0.40810E+01, 0.40887E+01, 0.40964E+01, 0.41041E+01, 0.41118E+01, + & 0.41195E+01, 0.41272E+01, 0.41348E+01, 0.41424E+01, 0.41501E+01, + & 0.41577E+01, 0.41653E+01, 0.41728E+01, 0.41804E+01, 0.41880E+01, + & 0.41955E+01, 0.42030E+01, 0.42105E+01, 0.42181E+01, 0.42255E+01, + & 0.42330E+01, 0.42405E+01, 0.42479E+01, 0.42554E+01, 0.42628E+01, + & 0.42702E+01, 0.42776E+01, 0.42850E+01, 0.42924E+01, 0.42998E+01, + & 0.43071E+01, 0.43145E+01, 0.43218E+01, 0.43291E+01, 0.43364E+01, + & 0.43437E+01, 0.43510E+01, 0.43583E+01, 0.43655E+01, 0.43728E+01, + & 0.43800E+01, 0.43872E+01, 0.43944E+01, 0.44016E+01, 0.44088E+01, + & 0.44160E+01, 0.44231E+01, 0.44303E+01, 0.44374E+01, 0.44446E+01, + & 0.44517E+01, 0.44588E+01, 0.44659E+01, 0.44729E+01, 0.44800E+01, + & 0.44871E+01, 0.44941E+01, 0.45012E+01, 0.45082E+01, 0.45152E+01, + & 0.45222E+01, 0.45292E+01, 0.45362E+01, 0.45431E+01, 0.45501E+01, + & 0.45570E+01, 0.45640E+01, 0.45709E+01, 0.45778E+01, 0.45847E+01, + & 0.45916E+01, 0.45985E+01, 0.46053E+01, 0.46122E+01, 0.46190E+01, + & 0.46259E+01, 0.46327E+01, 0.46395E+01, 0.46463E+01, 0.46531E+01, + & 0.46599E+01, 0.46667E+01, 0.46734E+01, 0.46802E+01, 0.46869E+01, + & 0.46936E+01, 0.47004E+01, 0.47071E+01, 0.47138E+01, 0.47205E+01/ + + DATA (BNC08M (I),I=501,600)/ + & 0.47271E+01, 0.47338E+01, 0.47405E+01, 0.47471E+01, 0.47537E+01, + & 0.47604E+01, 0.47670E+01, 0.47736E+01, 0.47802E+01, 0.47868E+01, + & 0.47934E+01, 0.47999E+01, 0.48065E+01, 0.48130E+01, 0.48196E+01, + & 0.48261E+01, 0.48326E+01, 0.48391E+01, 0.48456E+01, 0.48521E+01, + & 0.48586E+01, 0.48650E+01, 0.48715E+01, 0.48779E+01, 0.48844E+01, + & 0.48908E+01, 0.48972E+01, 0.49036E+01, 0.49100E+01, 0.49164E+01, + & 0.49228E+01, 0.49292E+01, 0.49355E+01, 0.49419E+01, 0.49482E+01, + & 0.49546E+01, 0.49609E+01, 0.49672E+01, 0.49735E+01, 0.49798E+01, + & 0.49861E+01, 0.49924E+01, 0.49986E+01, 0.50049E+01, 0.50112E+01, + & 0.50174E+01, 0.50236E+01, 0.50299E+01, 0.50361E+01, 0.50423E+01, + & 0.50485E+01, 0.50547E+01, 0.50608E+01, 0.50670E+01, 0.50732E+01, + & 0.50793E+01, 0.50855E+01, 0.50916E+01, 0.50977E+01, 0.51038E+01, + & 0.51099E+01, 0.51160E+01, 0.51221E+01, 0.51282E+01, 0.51343E+01, + & 0.51403E+01, 0.51464E+01, 0.51524E+01, 0.51585E+01, 0.51645E+01, + & 0.51705E+01, 0.51765E+01, 0.51825E+01, 0.51885E+01, 0.51945E+01, + & 0.52005E+01, 0.52065E+01, 0.52124E+01, 0.52184E+01, 0.52243E+01, + & 0.52303E+01, 0.52362E+01, 0.52421E+01, 0.52480E+01, 0.52539E+01, + & 0.52598E+01, 0.52657E+01, 0.52716E+01, 0.52775E+01, 0.52833E+01, + & 0.52892E+01, 0.52950E+01, 0.53009E+01, 0.53067E+01, 0.53125E+01, + & 0.53183E+01, 0.53241E+01, 0.53299E+01, 0.53357E+01, 0.53574E+01/ + + DATA (BNC08M (I),I=601,700)/ + & 0.54046E+01, 0.54611E+01, 0.55169E+01, 0.55719E+01, 0.56263E+01, + & 0.56799E+01, 0.57328E+01, 0.57851E+01, 0.58367E+01, 0.58877E+01, + & 0.59380E+01, 0.59878E+01, 0.60369E+01, 0.60855E+01, 0.61334E+01, + & 0.61808E+01, 0.62277E+01, 0.62740E+01, 0.63198E+01, 0.63651E+01, + & 0.64099E+01, 0.64542E+01, 0.64979E+01, 0.65413E+01, 0.65841E+01, + & 0.66265E+01, 0.66684E+01, 0.67099E+01, 0.67509E+01, 0.67916E+01, + & 0.68318E+01, 0.68715E+01, 0.69109E+01, 0.69499E+01, 0.69885E+01, + & 0.70267E+01, 0.70646E+01, 0.71020E+01, 0.71391E+01, 0.71759E+01, + & 0.72123E+01, 0.72483E+01, 0.72840E+01, 0.73194E+01, 0.73544E+01, + & 0.73891E+01, 0.74235E+01, 0.74576E+01, 0.74914E+01, 0.75248E+01, + & 0.75580E+01, 0.75909E+01, 0.76234E+01, 0.76557E+01, 0.76877E+01, + & 0.77195E+01, 0.77509E+01, 0.77821E+01, 0.78130E+01, 0.78437E+01, + & 0.78741E+01, 0.79042E+01, 0.79341E+01, 0.79637E+01, 0.79931E+01, + & 0.80223E+01, 0.80512E+01, 0.80799E+01, 0.81083E+01, 0.81365E+01, + & 0.81645E+01, 0.81923E+01, 0.82199E+01, 0.82472E+01, 0.82743E+01, + & 0.83012E+01, 0.83279E+01, 0.83544E+01, 0.83807E+01, 0.84068E+01, + & 0.84327E+01, 0.84584E+01, 0.84839E+01, 0.85093E+01, 0.85344E+01, + & 0.85593E+01, 0.85841E+01, 0.86087E+01, 0.86331E+01, 0.86573E+01, + & 0.86813E+01, 0.87052E+01, 0.87289E+01, 0.87524E+01, 0.87758E+01, + & 0.87990E+01, 0.88220E+01, 0.88449E+01, 0.88676E+01, 0.88902E+01/ + + DATA (BNC08M(I),I=701,741)/ + & 0.89126E+01, 0.89348E+01, 0.89569E+01, 0.89789E+01, 0.90006E+01, + & 0.90223E+01, 0.90438E+01, 0.90651E+01, 0.90863E+01, 0.91074E+01, + & 0.91283E+01, 0.91491E+01, 0.91698E+01, 0.91903E+01, 0.92107E+01, + & 0.92309E+01, 0.92510E+01, 0.92710E+01, 0.92909E+01, 0.93106E+01, + & 0.93302E+01, 0.93497E+01, 0.93690E+01, 0.93883E+01, 0.94074E+01, + & 0.94264E+01, 0.94452E+01, 0.94640E+01, 0.94826E+01, 0.95011E+01, + & 0.95195E+01, 0.95378E+01, 0.95560E+01, 0.95741E+01, 0.95920E+01, + & 0.96099E+01, 0.96276E+01, 0.96452E+01, 0.96628E+01, 0.96802E+01, + & 0.96975E+01 + & / +C +C *** NH4HSO4 +C + DATA (BNC09M (I),I= 1,100)/ + &-0.55422E-01,-0.99324E-01,-0.12935E+00,-0.14934E+00,-0.16445E+00, + &-0.17660E+00,-0.18672E+00,-0.19536E+00,-0.20285E+00,-0.20943E+00, + &-0.21526E+00,-0.22046E+00,-0.22511E+00,-0.22929E+00,-0.23305E+00, + &-0.23643E+00,-0.23948E+00,-0.24222E+00,-0.24468E+00,-0.24688E+00, + &-0.24884E+00,-0.25058E+00,-0.25210E+00,-0.25342E+00,-0.25456E+00, + &-0.25551E+00,-0.25630E+00,-0.25692E+00,-0.25739E+00,-0.25771E+00, + &-0.25789E+00,-0.25794E+00,-0.25785E+00,-0.25763E+00,-0.25730E+00, + &-0.25685E+00,-0.25628E+00,-0.25561E+00,-0.25483E+00,-0.25395E+00, + &-0.25297E+00,-0.25190E+00,-0.25074E+00,-0.24948E+00,-0.24815E+00, + &-0.24673E+00,-0.24523E+00,-0.24366E+00,-0.24201E+00,-0.24029E+00, + &-0.23850E+00,-0.23664E+00,-0.23472E+00,-0.23274E+00,-0.23069E+00, + &-0.22859E+00,-0.22643E+00,-0.22421E+00,-0.22194E+00,-0.21962E+00, + &-0.21725E+00,-0.21483E+00,-0.21236E+00,-0.20985E+00,-0.20729E+00, + &-0.20468E+00,-0.20203E+00,-0.19934E+00,-0.19661E+00,-0.19384E+00, + &-0.19102E+00,-0.18817E+00,-0.18528E+00,-0.18235E+00,-0.17938E+00, + &-0.17637E+00,-0.17333E+00,-0.17025E+00,-0.16713E+00,-0.16398E+00, + &-0.16079E+00,-0.15757E+00,-0.15431E+00,-0.15101E+00,-0.14768E+00, + &-0.14432E+00,-0.14092E+00,-0.13750E+00,-0.13403E+00,-0.13054E+00, + &-0.12701E+00,-0.12346E+00,-0.11987E+00,-0.11626E+00,-0.11261E+00, + &-0.10894E+00,-0.10524E+00,-0.10152E+00,-0.97765E-01,-0.93990E-01/ + + DATA (BNC09M (I),I=101,200)/ + &-0.90192E-01,-0.86371E-01,-0.82530E-01,-0.78668E-01,-0.74788E-01, + &-0.70889E-01,-0.66974E-01,-0.63042E-01,-0.59097E-01,-0.55137E-01, + &-0.51165E-01,-0.47182E-01,-0.43188E-01,-0.39185E-01,-0.35173E-01, + &-0.31154E-01,-0.27129E-01,-0.23099E-01,-0.19063E-01,-0.15024E-01, + &-0.11398E-01,-0.73058E-02,-0.32173E-02, 0.86749E-03, 0.49480E-02, + & 0.90243E-02, 0.13096E-01, 0.17162E-01, 0.21224E-01, 0.25280E-01, + & 0.29330E-01, 0.33374E-01, 0.37412E-01, 0.41443E-01, 0.45469E-01, + & 0.49487E-01, 0.53498E-01, 0.57502E-01, 0.61499E-01, 0.65488E-01, + & 0.69470E-01, 0.73444E-01, 0.77410E-01, 0.81368E-01, 0.85318E-01, + & 0.89260E-01, 0.93194E-01, 0.97118E-01, 0.10103E+00, 0.10494E+00, + & 0.10884E+00, 0.11273E+00, 0.11661E+00, 0.12049E+00, 0.12435E+00, + & 0.12820E+00, 0.13205E+00, 0.13588E+00, 0.13971E+00, 0.14353E+00, + & 0.14733E+00, 0.15113E+00, 0.15492E+00, 0.15870E+00, 0.16247E+00, + & 0.16623E+00, 0.16998E+00, 0.17373E+00, 0.17746E+00, 0.18118E+00, + & 0.18489E+00, 0.18860E+00, 0.19229E+00, 0.19597E+00, 0.19965E+00, + & 0.20331E+00, 0.20697E+00, 0.21061E+00, 0.21425E+00, 0.21787E+00, + & 0.22149E+00, 0.22510E+00, 0.22869E+00, 0.23228E+00, 0.23586E+00, + & 0.23943E+00, 0.24299E+00, 0.24654E+00, 0.25008E+00, 0.25361E+00, + & 0.25713E+00, 0.26064E+00, 0.26414E+00, 0.26763E+00, 0.27112E+00, + & 0.27459E+00, 0.27805E+00, 0.28151E+00, 0.28495E+00, 0.28839E+00/ + + DATA (BNC09M (I),I=201,300)/ + & 0.29182E+00, 0.29523E+00, 0.29864E+00, 0.30204E+00, 0.30543E+00, + & 0.30881E+00, 0.31218E+00, 0.31555E+00, 0.31890E+00, 0.32225E+00, + & 0.32558E+00, 0.32891E+00, 0.33223E+00, 0.33553E+00, 0.33883E+00, + & 0.34213E+00, 0.34541E+00, 0.34868E+00, 0.35195E+00, 0.35520E+00, + & 0.35845E+00, 0.36169E+00, 0.36492E+00, 0.36814E+00, 0.37135E+00, + & 0.37456E+00, 0.37775E+00, 0.38094E+00, 0.38412E+00, 0.38729E+00, + & 0.39045E+00, 0.39361E+00, 0.39675E+00, 0.39989E+00, 0.40302E+00, + & 0.40614E+00, 0.40925E+00, 0.41236E+00, 0.41546E+00, 0.41854E+00, + & 0.42162E+00, 0.42470E+00, 0.42776E+00, 0.43082E+00, 0.43387E+00, + & 0.43691E+00, 0.43994E+00, 0.44297E+00, 0.44598E+00, 0.44899E+00, + & 0.45200E+00, 0.45499E+00, 0.45798E+00, 0.46096E+00, 0.46393E+00, + & 0.46689E+00, 0.46985E+00, 0.47280E+00, 0.47574E+00, 0.47867E+00, + & 0.48160E+00, 0.48452E+00, 0.48743E+00, 0.49033E+00, 0.49323E+00, + & 0.49612E+00, 0.49900E+00, 0.50188E+00, 0.50475E+00, 0.50761E+00, + & 0.51046E+00, 0.51331E+00, 0.51615E+00, 0.51898E+00, 0.52181E+00, + & 0.52463E+00, 0.52744E+00, 0.53025E+00, 0.53305E+00, 0.53584E+00, + & 0.53862E+00, 0.54140E+00, 0.54417E+00, 0.54694E+00, 0.54969E+00, + & 0.55244E+00, 0.55519E+00, 0.55793E+00, 0.56066E+00, 0.56338E+00, + & 0.56610E+00, 0.56881E+00, 0.57152E+00, 0.57422E+00, 0.57691E+00, + & 0.57959E+00, 0.58227E+00, 0.58495E+00, 0.58761E+00, 0.59027E+00/ + + DATA (BNC09M (I),I=301,400)/ + & 0.59293E+00, 0.59558E+00, 0.59822E+00, 0.60085E+00, 0.60348E+00, + & 0.60611E+00, 0.60872E+00, 0.61133E+00, 0.61394E+00, 0.61654E+00, + & 0.61913E+00, 0.62172E+00, 0.62430E+00, 0.62687E+00, 0.62944E+00, + & 0.63200E+00, 0.63456E+00, 0.63711E+00, 0.63966E+00, 0.64219E+00, + & 0.64473E+00, 0.64726E+00, 0.64978E+00, 0.65229E+00, 0.65480E+00, + & 0.65731E+00, 0.65981E+00, 0.66230E+00, 0.66479E+00, 0.66727E+00, + & 0.66975E+00, 0.67222E+00, 0.67468E+00, 0.67714E+00, 0.67960E+00, + & 0.68205E+00, 0.68449E+00, 0.68693E+00, 0.68936E+00, 0.69179E+00, + & 0.69421E+00, 0.69663E+00, 0.69904E+00, 0.70144E+00, 0.70384E+00, + & 0.70624E+00, 0.70863E+00, 0.71101E+00, 0.71339E+00, 0.71577E+00, + & 0.71813E+00, 0.72050E+00, 0.72286E+00, 0.72521E+00, 0.72756E+00, + & 0.72990E+00, 0.73224E+00, 0.73457E+00, 0.73690E+00, 0.73922E+00, + & 0.74154E+00, 0.74386E+00, 0.74616E+00, 0.74847E+00, 0.75076E+00, + & 0.75306E+00, 0.75535E+00, 0.75763E+00, 0.75991E+00, 0.76218E+00, + & 0.76445E+00, 0.76671E+00, 0.76897E+00, 0.77123E+00, 0.77348E+00, + & 0.77572E+00, 0.77796E+00, 0.78020E+00, 0.78243E+00, 0.78465E+00, + & 0.78687E+00, 0.78909E+00, 0.79130E+00, 0.79351E+00, 0.79571E+00, + & 0.79791E+00, 0.80010E+00, 0.80229E+00, 0.80448E+00, 0.80666E+00, + & 0.80883E+00, 0.81100E+00, 0.81317E+00, 0.81533E+00, 0.81749E+00, + & 0.81964E+00, 0.82179E+00, 0.82394E+00, 0.82608E+00, 0.82821E+00/ + + DATA (BNC09M (I),I=401,500)/ + & 0.83034E+00, 0.83247E+00, 0.83459E+00, 0.83671E+00, 0.83882E+00, + & 0.84093E+00, 0.84304E+00, 0.84514E+00, 0.84723E+00, 0.84933E+00, + & 0.85141E+00, 0.85350E+00, 0.85558E+00, 0.85765E+00, 0.85972E+00, + & 0.86179E+00, 0.86385E+00, 0.86591E+00, 0.86797E+00, 0.87002E+00, + & 0.87207E+00, 0.87411E+00, 0.87615E+00, 0.87818E+00, 0.88021E+00, + & 0.88224E+00, 0.88426E+00, 0.88628E+00, 0.88829E+00, 0.89030E+00, + & 0.89231E+00, 0.89431E+00, 0.89631E+00, 0.89830E+00, 0.90029E+00, + & 0.90228E+00, 0.90426E+00, 0.90624E+00, 0.90822E+00, 0.91019E+00, + & 0.91216E+00, 0.91412E+00, 0.91608E+00, 0.91803E+00, 0.91999E+00, + & 0.92193E+00, 0.92388E+00, 0.92582E+00, 0.92776E+00, 0.92969E+00, + & 0.93162E+00, 0.93354E+00, 0.93547E+00, 0.93738E+00, 0.93930E+00, + & 0.94121E+00, 0.94312E+00, 0.94502E+00, 0.94692E+00, 0.94882E+00, + & 0.95071E+00, 0.95260E+00, 0.95448E+00, 0.95637E+00, 0.95824E+00, + & 0.96012E+00, 0.96199E+00, 0.96386E+00, 0.96572E+00, 0.96758E+00, + & 0.96944E+00, 0.97129E+00, 0.97314E+00, 0.97499E+00, 0.97683E+00, + & 0.97867E+00, 0.98051E+00, 0.98234E+00, 0.98417E+00, 0.98600E+00, + & 0.98782E+00, 0.98964E+00, 0.99145E+00, 0.99327E+00, 0.99507E+00, + & 0.99688E+00, 0.99868E+00, 0.10005E+01, 0.10023E+01, 0.10041E+01, + & 0.10059E+01, 0.10076E+01, 0.10094E+01, 0.10112E+01, 0.10130E+01, + & 0.10148E+01, 0.10165E+01, 0.10183E+01, 0.10200E+01, 0.10218E+01/ + + DATA (BNC09M (I),I=501,600)/ + & 0.10236E+01, 0.10253E+01, 0.10271E+01, 0.10288E+01, 0.10306E+01, + & 0.10323E+01, 0.10340E+01, 0.10358E+01, 0.10375E+01, 0.10392E+01, + & 0.10409E+01, 0.10427E+01, 0.10444E+01, 0.10461E+01, 0.10478E+01, + & 0.10495E+01, 0.10512E+01, 0.10529E+01, 0.10546E+01, 0.10563E+01, + & 0.10580E+01, 0.10597E+01, 0.10614E+01, 0.10631E+01, 0.10648E+01, + & 0.10664E+01, 0.10681E+01, 0.10698E+01, 0.10715E+01, 0.10731E+01, + & 0.10748E+01, 0.10765E+01, 0.10781E+01, 0.10798E+01, 0.10814E+01, + & 0.10831E+01, 0.10847E+01, 0.10864E+01, 0.10880E+01, 0.10896E+01, + & 0.10913E+01, 0.10929E+01, 0.10945E+01, 0.10961E+01, 0.10978E+01, + & 0.10994E+01, 0.11010E+01, 0.11026E+01, 0.11042E+01, 0.11058E+01, + & 0.11074E+01, 0.11090E+01, 0.11106E+01, 0.11122E+01, 0.11138E+01, + & 0.11154E+01, 0.11170E+01, 0.11186E+01, 0.11202E+01, 0.11218E+01, + & 0.11233E+01, 0.11249E+01, 0.11265E+01, 0.11281E+01, 0.11296E+01, + & 0.11312E+01, 0.11328E+01, 0.11343E+01, 0.11359E+01, 0.11374E+01, + & 0.11390E+01, 0.11405E+01, 0.11421E+01, 0.11436E+01, 0.11451E+01, + & 0.11467E+01, 0.11482E+01, 0.11497E+01, 0.11513E+01, 0.11528E+01, + & 0.11543E+01, 0.11559E+01, 0.11574E+01, 0.11589E+01, 0.11604E+01, + & 0.11619E+01, 0.11634E+01, 0.11649E+01, 0.11664E+01, 0.11679E+01, + & 0.11694E+01, 0.11709E+01, 0.11724E+01, 0.11739E+01, 0.11754E+01, + & 0.11769E+01, 0.11784E+01, 0.11798E+01, 0.11813E+01, 0.11868E+01/ + + DATA (BNC09M (I),I=601,700)/ + & 0.11989E+01, 0.12132E+01, 0.12273E+01, 0.12412E+01, 0.12549E+01, + & 0.12683E+01, 0.12816E+01, 0.12946E+01, 0.13074E+01, 0.13200E+01, + & 0.13324E+01, 0.13446E+01, 0.13566E+01, 0.13685E+01, 0.13801E+01, + & 0.13916E+01, 0.14029E+01, 0.14141E+01, 0.14250E+01, 0.14358E+01, + & 0.14465E+01, 0.14570E+01, 0.14673E+01, 0.14775E+01, 0.14875E+01, + & 0.14974E+01, 0.15072E+01, 0.15168E+01, 0.15262E+01, 0.15356E+01, + & 0.15448E+01, 0.15538E+01, 0.15628E+01, 0.15716E+01, 0.15803E+01, + & 0.15888E+01, 0.15973E+01, 0.16056E+01, 0.16138E+01, 0.16219E+01, + & 0.16299E+01, 0.16378E+01, 0.16455E+01, 0.16532E+01, 0.16608E+01, + & 0.16682E+01, 0.16756E+01, 0.16828E+01, 0.16900E+01, 0.16970E+01, + & 0.17040E+01, 0.17108E+01, 0.17176E+01, 0.17243E+01, 0.17308E+01, + & 0.17373E+01, 0.17438E+01, 0.17501E+01, 0.17563E+01, 0.17625E+01, + & 0.17685E+01, 0.17745E+01, 0.17804E+01, 0.17863E+01, 0.17920E+01, + & 0.17977E+01, 0.18033E+01, 0.18088E+01, 0.18142E+01, 0.18196E+01, + & 0.18249E+01, 0.18302E+01, 0.18353E+01, 0.18404E+01, 0.18454E+01, + & 0.18504E+01, 0.18553E+01, 0.18601E+01, 0.18649E+01, 0.18695E+01, + & 0.18742E+01, 0.18787E+01, 0.18832E+01, 0.18877E+01, 0.18921E+01, + & 0.18964E+01, 0.19007E+01, 0.19049E+01, 0.19090E+01, 0.19131E+01, + & 0.19171E+01, 0.19211E+01, 0.19250E+01, 0.19289E+01, 0.19327E+01, + & 0.19365E+01, 0.19402E+01, 0.19439E+01, 0.19475E+01, 0.19510E+01/ + + DATA (BNC09M(I),I=701,741)/ + & 0.19545E+01, 0.19580E+01, 0.19614E+01, 0.19647E+01, 0.19681E+01, + & 0.19713E+01, 0.19745E+01, 0.19777E+01, 0.19808E+01, 0.19839E+01, + & 0.19869E+01, 0.19899E+01, 0.19929E+01, 0.19958E+01, 0.19986E+01, + & 0.20014E+01, 0.20042E+01, 0.20069E+01, 0.20096E+01, 0.20123E+01, + & 0.20149E+01, 0.20175E+01, 0.20200E+01, 0.20225E+01, 0.20249E+01, + & 0.20273E+01, 0.20297E+01, 0.20320E+01, 0.20343E+01, 0.20366E+01, + & 0.20388E+01, 0.20410E+01, 0.20432E+01, 0.20453E+01, 0.20473E+01, + & 0.20494E+01, 0.20514E+01, 0.20534E+01, 0.20553E+01, 0.20572E+01, + & 0.20591E+01 + & / +C +C *** (H, NO3) +C + DATA (BNC10M (I),I= 1,100)/ + &-0.54443E-01,-0.95281E-01,-0.12118E+00,-0.13706E+00,-0.14810E+00, + &-0.15622E+00,-0.16239E+00,-0.16713E+00,-0.17079E+00,-0.17360E+00, + &-0.17573E+00,-0.17729E+00,-0.17838E+00,-0.17908E+00,-0.17943E+00, + &-0.17948E+00,-0.17928E+00,-0.17885E+00,-0.17821E+00,-0.17740E+00, + &-0.17642E+00,-0.17531E+00,-0.17407E+00,-0.17271E+00,-0.17124E+00, + &-0.16969E+00,-0.16805E+00,-0.16633E+00,-0.16455E+00,-0.16270E+00, + &-0.16080E+00,-0.15884E+00,-0.15684E+00,-0.15480E+00,-0.15272E+00, + &-0.15061E+00,-0.14847E+00,-0.14631E+00,-0.14412E+00,-0.14191E+00, + &-0.13968E+00,-0.13744E+00,-0.13518E+00,-0.13291E+00,-0.13063E+00, + &-0.12834E+00,-0.12605E+00,-0.12375E+00,-0.12144E+00,-0.11913E+00, + &-0.11682E+00,-0.11450E+00,-0.11218E+00,-0.10986E+00,-0.10754E+00, + &-0.10521E+00,-0.10289E+00,-0.10056E+00,-0.98232E-01,-0.95901E-01, + &-0.93569E-01,-0.91233E-01,-0.88895E-01,-0.86553E-01,-0.84207E-01, + &-0.81856E-01,-0.79499E-01,-0.77136E-01,-0.74766E-01,-0.72388E-01, + &-0.70002E-01,-0.67607E-01,-0.65201E-01,-0.62784E-01,-0.60355E-01, + &-0.57914E-01,-0.55459E-01,-0.52990E-01,-0.50507E-01,-0.48008E-01, + &-0.45493E-01,-0.42962E-01,-0.40413E-01,-0.37847E-01,-0.35263E-01, + &-0.32660E-01,-0.30039E-01,-0.27400E-01,-0.24741E-01,-0.22063E-01, + &-0.19367E-01,-0.16651E-01,-0.13917E-01,-0.11164E-01,-0.83926E-02, + &-0.56031E-02,-0.27959E-02, 0.28739E-04, 0.28702E-02, 0.57282E-02/ + + DATA (BNC10M (I),I=101,200)/ + & 0.86021E-02, 0.11491E-01, 0.14395E-01, 0.17314E-01, 0.20245E-01, + & 0.23190E-01, 0.26147E-01, 0.29115E-01, 0.32095E-01, 0.35084E-01, + & 0.38083E-01, 0.41091E-01, 0.44107E-01, 0.47130E-01, 0.50160E-01, + & 0.53197E-01, 0.56239E-01, 0.59286E-01, 0.62338E-01, 0.65393E-01, + & 0.68068E-01, 0.71174E-01, 0.74277E-01, 0.77379E-01, 0.80478E-01, + & 0.83575E-01, 0.86669E-01, 0.89761E-01, 0.92850E-01, 0.95936E-01, + & 0.99019E-01, 0.10210E+00, 0.10518E+00, 0.10825E+00, 0.11132E+00, + & 0.11439E+00, 0.11746E+00, 0.12052E+00, 0.12358E+00, 0.12663E+00, + & 0.12968E+00, 0.13273E+00, 0.13578E+00, 0.13882E+00, 0.14185E+00, + & 0.14489E+00, 0.14792E+00, 0.15094E+00, 0.15397E+00, 0.15698E+00, + & 0.16000E+00, 0.16301E+00, 0.16601E+00, 0.16902E+00, 0.17201E+00, + & 0.17501E+00, 0.17800E+00, 0.18098E+00, 0.18396E+00, 0.18694E+00, + & 0.18991E+00, 0.19288E+00, 0.19585E+00, 0.19881E+00, 0.20176E+00, + & 0.20471E+00, 0.20766E+00, 0.21060E+00, 0.21354E+00, 0.21647E+00, + & 0.21940E+00, 0.22232E+00, 0.22524E+00, 0.22816E+00, 0.23107E+00, + & 0.23397E+00, 0.23687E+00, 0.23977E+00, 0.24266E+00, 0.24554E+00, + & 0.24843E+00, 0.25130E+00, 0.25418E+00, 0.25704E+00, 0.25991E+00, + & 0.26276E+00, 0.26562E+00, 0.26846E+00, 0.27131E+00, 0.27415E+00, + & 0.27698E+00, 0.27981E+00, 0.28263E+00, 0.28545E+00, 0.28827E+00, + & 0.29107E+00, 0.29388E+00, 0.29668E+00, 0.29947E+00, 0.30226E+00/ + + DATA (BNC10M (I),I=201,300)/ + & 0.30505E+00, 0.30783E+00, 0.31060E+00, 0.31337E+00, 0.31614E+00, + & 0.31890E+00, 0.32165E+00, 0.32440E+00, 0.32715E+00, 0.32989E+00, + & 0.33262E+00, 0.33535E+00, 0.33808E+00, 0.34080E+00, 0.34351E+00, + & 0.34622E+00, 0.34893E+00, 0.35163E+00, 0.35432E+00, 0.35701E+00, + & 0.35970E+00, 0.36238E+00, 0.36505E+00, 0.36772E+00, 0.37039E+00, + & 0.37305E+00, 0.37571E+00, 0.37836E+00, 0.38100E+00, 0.38364E+00, + & 0.38628E+00, 0.38891E+00, 0.39153E+00, 0.39416E+00, 0.39677E+00, + & 0.39938E+00, 0.40199E+00, 0.40459E+00, 0.40719E+00, 0.40978E+00, + & 0.41236E+00, 0.41495E+00, 0.41752E+00, 0.42009E+00, 0.42266E+00, + & 0.42522E+00, 0.42778E+00, 0.43033E+00, 0.43288E+00, 0.43542E+00, + & 0.43796E+00, 0.44049E+00, 0.44302E+00, 0.44554E+00, 0.44806E+00, + & 0.45057E+00, 0.45308E+00, 0.45559E+00, 0.45808E+00, 0.46058E+00, + & 0.46307E+00, 0.46555E+00, 0.46803E+00, 0.47051E+00, 0.47298E+00, + & 0.47544E+00, 0.47790E+00, 0.48036E+00, 0.48281E+00, 0.48526E+00, + & 0.48770E+00, 0.49013E+00, 0.49257E+00, 0.49499E+00, 0.49742E+00, + & 0.49983E+00, 0.50225E+00, 0.50466E+00, 0.50706E+00, 0.50946E+00, + & 0.51185E+00, 0.51424E+00, 0.51663E+00, 0.51901E+00, 0.52139E+00, + & 0.52376E+00, 0.52612E+00, 0.52849E+00, 0.53084E+00, 0.53320E+00, + & 0.53555E+00, 0.53789E+00, 0.54023E+00, 0.54257E+00, 0.54490E+00, + & 0.54722E+00, 0.54954E+00, 0.55186E+00, 0.55417E+00, 0.55648E+00/ + + DATA (BNC10M (I),I=301,400)/ + & 0.55878E+00, 0.56108E+00, 0.56338E+00, 0.56567E+00, 0.56795E+00, + & 0.57023E+00, 0.57251E+00, 0.57478E+00, 0.57705E+00, 0.57932E+00, + & 0.58157E+00, 0.58383E+00, 0.58608E+00, 0.58833E+00, 0.59057E+00, + & 0.59280E+00, 0.59504E+00, 0.59727E+00, 0.59949E+00, 0.60171E+00, + & 0.60393E+00, 0.60614E+00, 0.60835E+00, 0.61055E+00, 0.61275E+00, + & 0.61494E+00, 0.61713E+00, 0.61932E+00, 0.62150E+00, 0.62368E+00, + & 0.62585E+00, 0.62802E+00, 0.63018E+00, 0.63234E+00, 0.63450E+00, + & 0.63665E+00, 0.63880E+00, 0.64095E+00, 0.64309E+00, 0.64522E+00, + & 0.64735E+00, 0.64948E+00, 0.65161E+00, 0.65372E+00, 0.65584E+00, + & 0.65795E+00, 0.66006E+00, 0.66216E+00, 0.66426E+00, 0.66636E+00, + & 0.66845E+00, 0.67053E+00, 0.67262E+00, 0.67470E+00, 0.67677E+00, + & 0.67884E+00, 0.68091E+00, 0.68297E+00, 0.68503E+00, 0.68709E+00, + & 0.68914E+00, 0.69119E+00, 0.69323E+00, 0.69527E+00, 0.69731E+00, + & 0.69934E+00, 0.70137E+00, 0.70339E+00, 0.70541E+00, 0.70743E+00, + & 0.70944E+00, 0.71145E+00, 0.71346E+00, 0.71546E+00, 0.71745E+00, + & 0.71945E+00, 0.72144E+00, 0.72342E+00, 0.72541E+00, 0.72738E+00, + & 0.72936E+00, 0.73133E+00, 0.73330E+00, 0.73526E+00, 0.73722E+00, + & 0.73918E+00, 0.74113E+00, 0.74308E+00, 0.74502E+00, 0.74697E+00, + & 0.74890E+00, 0.75084E+00, 0.75277E+00, 0.75470E+00, 0.75662E+00, + & 0.75854E+00, 0.76046E+00, 0.76237E+00, 0.76428E+00, 0.76618E+00/ + + DATA (BNC10M (I),I=401,500)/ + & 0.76808E+00, 0.76998E+00, 0.77188E+00, 0.77377E+00, 0.77566E+00, + & 0.77754E+00, 0.77942E+00, 0.78130E+00, 0.78317E+00, 0.78504E+00, + & 0.78691E+00, 0.78877E+00, 0.79063E+00, 0.79249E+00, 0.79434E+00, + & 0.79619E+00, 0.79803E+00, 0.79988E+00, 0.80171E+00, 0.80355E+00, + & 0.80538E+00, 0.80721E+00, 0.80904E+00, 0.81086E+00, 0.81268E+00, + & 0.81449E+00, 0.81630E+00, 0.81811E+00, 0.81992E+00, 0.82172E+00, + & 0.82352E+00, 0.82531E+00, 0.82710E+00, 0.82889E+00, 0.83068E+00, + & 0.83246E+00, 0.83424E+00, 0.83601E+00, 0.83779E+00, 0.83955E+00, + & 0.84132E+00, 0.84308E+00, 0.84484E+00, 0.84660E+00, 0.84835E+00, + & 0.85010E+00, 0.85185E+00, 0.85359E+00, 0.85533E+00, 0.85707E+00, + & 0.85880E+00, 0.86053E+00, 0.86226E+00, 0.86398E+00, 0.86570E+00, + & 0.86742E+00, 0.86914E+00, 0.87085E+00, 0.87256E+00, 0.87426E+00, + & 0.87596E+00, 0.87766E+00, 0.87936E+00, 0.88105E+00, 0.88274E+00, + & 0.88443E+00, 0.88611E+00, 0.88779E+00, 0.88947E+00, 0.89115E+00, + & 0.89282E+00, 0.89449E+00, 0.89615E+00, 0.89782E+00, 0.89948E+00, + & 0.90113E+00, 0.90279E+00, 0.90444E+00, 0.90608E+00, 0.90773E+00, + & 0.90937E+00, 0.91101E+00, 0.91265E+00, 0.91428E+00, 0.91591E+00, + & 0.91754E+00, 0.91916E+00, 0.92078E+00, 0.92240E+00, 0.92402E+00, + & 0.92563E+00, 0.92724E+00, 0.92885E+00, 0.93045E+00, 0.93205E+00, + & 0.93365E+00, 0.93525E+00, 0.93684E+00, 0.93843E+00, 0.94002E+00/ + + DATA (BNC10M (I),I=501,600)/ + & 0.94160E+00, 0.94318E+00, 0.94476E+00, 0.94634E+00, 0.94791E+00, + & 0.94948E+00, 0.95105E+00, 0.95261E+00, 0.95418E+00, 0.95574E+00, + & 0.95729E+00, 0.95885E+00, 0.96040E+00, 0.96195E+00, 0.96349E+00, + & 0.96504E+00, 0.96658E+00, 0.96811E+00, 0.96965E+00, 0.97118E+00, + & 0.97271E+00, 0.97424E+00, 0.97576E+00, 0.97728E+00, 0.97880E+00, + & 0.98032E+00, 0.98183E+00, 0.98334E+00, 0.98485E+00, 0.98635E+00, + & 0.98786E+00, 0.98936E+00, 0.99086E+00, 0.99235E+00, 0.99384E+00, + & 0.99533E+00, 0.99682E+00, 0.99831E+00, 0.99979E+00, 0.10013E+01, + & 0.10027E+01, 0.10042E+01, 0.10057E+01, 0.10072E+01, 0.10086E+01, + & 0.10101E+01, 0.10116E+01, 0.10130E+01, 0.10145E+01, 0.10159E+01, + & 0.10174E+01, 0.10188E+01, 0.10203E+01, 0.10217E+01, 0.10232E+01, + & 0.10246E+01, 0.10260E+01, 0.10275E+01, 0.10289E+01, 0.10303E+01, + & 0.10318E+01, 0.10332E+01, 0.10346E+01, 0.10360E+01, 0.10374E+01, + & 0.10389E+01, 0.10403E+01, 0.10417E+01, 0.10431E+01, 0.10445E+01, + & 0.10459E+01, 0.10473E+01, 0.10487E+01, 0.10501E+01, 0.10515E+01, + & 0.10529E+01, 0.10543E+01, 0.10556E+01, 0.10570E+01, 0.10584E+01, + & 0.10598E+01, 0.10612E+01, 0.10625E+01, 0.10639E+01, 0.10653E+01, + & 0.10666E+01, 0.10680E+01, 0.10694E+01, 0.10707E+01, 0.10721E+01, + & 0.10734E+01, 0.10748E+01, 0.10762E+01, 0.10775E+01, 0.10788E+01, + & 0.10802E+01, 0.10815E+01, 0.10829E+01, 0.10842E+01, 0.10892E+01/ + + DATA (BNC10M (I),I=601,700)/ + & 0.11001E+01, 0.11131E+01, 0.11259E+01, 0.11384E+01, 0.11508E+01, + & 0.11629E+01, 0.11749E+01, 0.11867E+01, 0.11983E+01, 0.12097E+01, + & 0.12209E+01, 0.12319E+01, 0.12428E+01, 0.12535E+01, 0.12640E+01, + & 0.12744E+01, 0.12846E+01, 0.12946E+01, 0.13045E+01, 0.13142E+01, + & 0.13238E+01, 0.13333E+01, 0.13426E+01, 0.13517E+01, 0.13607E+01, + & 0.13696E+01, 0.13784E+01, 0.13870E+01, 0.13955E+01, 0.14038E+01, + & 0.14121E+01, 0.14202E+01, 0.14282E+01, 0.14361E+01, 0.14438E+01, + & 0.14515E+01, 0.14590E+01, 0.14664E+01, 0.14738E+01, 0.14810E+01, + & 0.14881E+01, 0.14951E+01, 0.15020E+01, 0.15088E+01, 0.15155E+01, + & 0.15221E+01, 0.15286E+01, 0.15350E+01, 0.15413E+01, 0.15475E+01, + & 0.15536E+01, 0.15597E+01, 0.15656E+01, 0.15715E+01, 0.15773E+01, + & 0.15830E+01, 0.15886E+01, 0.15942E+01, 0.15996E+01, 0.16050E+01, + & 0.16103E+01, 0.16155E+01, 0.16207E+01, 0.16258E+01, 0.16308E+01, + & 0.16357E+01, 0.16406E+01, 0.16453E+01, 0.16501E+01, 0.16547E+01, + & 0.16593E+01, 0.16638E+01, 0.16682E+01, 0.16726E+01, 0.16769E+01, + & 0.16812E+01, 0.16854E+01, 0.16895E+01, 0.16936E+01, 0.16976E+01, + & 0.17015E+01, 0.17054E+01, 0.17092E+01, 0.17130E+01, 0.17167E+01, + & 0.17204E+01, 0.17240E+01, 0.17275E+01, 0.17310E+01, 0.17345E+01, + & 0.17379E+01, 0.17412E+01, 0.17445E+01, 0.17477E+01, 0.17509E+01, + & 0.17540E+01, 0.17571E+01, 0.17601E+01, 0.17631E+01, 0.17660E+01/ + + DATA (BNC10M(I),I=701,741)/ + & 0.17689E+01, 0.17718E+01, 0.17746E+01, 0.17773E+01, 0.17800E+01, + & 0.17827E+01, 0.17853E+01, 0.17879E+01, 0.17904E+01, 0.17929E+01, + & 0.17953E+01, 0.17977E+01, 0.18001E+01, 0.18024E+01, 0.18047E+01, + & 0.18069E+01, 0.18091E+01, 0.18113E+01, 0.18134E+01, 0.18155E+01, + & 0.18175E+01, 0.18195E+01, 0.18215E+01, 0.18234E+01, 0.18253E+01, + & 0.18271E+01, 0.18290E+01, 0.18307E+01, 0.18325E+01, 0.18342E+01, + & 0.18359E+01, 0.18375E+01, 0.18391E+01, 0.18407E+01, 0.18423E+01, + & 0.18438E+01, 0.18453E+01, 0.18467E+01, 0.18481E+01, 0.18495E+01, + & 0.18509E+01 + & / +C +C *** (H, Cl) +C + DATA (BNC11M (I),I= 1,100)/ + &-0.52529E-01,-0.88720E-01,-0.10935E+00,-0.12044E+00,-0.12697E+00, + &-0.13075E+00,-0.13267E+00,-0.13322E+00,-0.13273E+00,-0.13141E+00, + &-0.12940E+00,-0.12681E+00,-0.12374E+00,-0.12024E+00,-0.11636E+00, + &-0.11215E+00,-0.10765E+00,-0.10287E+00,-0.97853E-01,-0.92611E-01, + &-0.87164E-01,-0.81529E-01,-0.75720E-01,-0.69751E-01,-0.63632E-01, + &-0.57375E-01,-0.50988E-01,-0.44482E-01,-0.37863E-01,-0.31140E-01, + &-0.24319E-01,-0.17407E-01,-0.10411E-01,-0.33352E-02, 0.38142E-02, + & 0.11032E-01, 0.18315E-01, 0.25656E-01, 0.33053E-01, 0.40501E-01, + & 0.47996E-01, 0.55536E-01, 0.63116E-01, 0.70734E-01, 0.78387E-01, + & 0.86072E-01, 0.93788E-01, 0.10153E+00, 0.10930E+00, 0.11709E+00, + & 0.12490E+00, 0.13274E+00, 0.14059E+00, 0.14847E+00, 0.15636E+00, + & 0.16426E+00, 0.17219E+00, 0.18013E+00, 0.18808E+00, 0.19605E+00, + & 0.20404E+00, 0.21204E+00, 0.22006E+00, 0.22810E+00, 0.23615E+00, + & 0.24422E+00, 0.25232E+00, 0.26043E+00, 0.26857E+00, 0.27673E+00, + & 0.28491E+00, 0.29312E+00, 0.30136E+00, 0.30962E+00, 0.31792E+00, + & 0.32624E+00, 0.33460E+00, 0.34299E+00, 0.35142E+00, 0.35989E+00, + & 0.36839E+00, 0.37693E+00, 0.38551E+00, 0.39413E+00, 0.40279E+00, + & 0.41150E+00, 0.42024E+00, 0.42903E+00, 0.43786E+00, 0.44674E+00, + & 0.45565E+00, 0.46462E+00, 0.47362E+00, 0.48266E+00, 0.49175E+00, + & 0.50087E+00, 0.51004E+00, 0.51925E+00, 0.52849E+00, 0.53777E+00/ + + DATA (BNC11M (I),I=101,200)/ + & 0.54708E+00, 0.55643E+00, 0.56581E+00, 0.57522E+00, 0.58465E+00, + & 0.59412E+00, 0.60361E+00, 0.61313E+00, 0.62267E+00, 0.63222E+00, + & 0.64180E+00, 0.65140E+00, 0.66101E+00, 0.67063E+00, 0.68027E+00, + & 0.68991E+00, 0.69957E+00, 0.70923E+00, 0.71890E+00, 0.72857E+00, + & 0.73737E+00, 0.74715E+00, 0.75692E+00, 0.76668E+00, 0.77643E+00, + & 0.78617E+00, 0.79590E+00, 0.80562E+00, 0.81533E+00, 0.82502E+00, + & 0.83470E+00, 0.84437E+00, 0.85403E+00, 0.86368E+00, 0.87331E+00, + & 0.88293E+00, 0.89253E+00, 0.90212E+00, 0.91170E+00, 0.92126E+00, + & 0.93081E+00, 0.94034E+00, 0.94986E+00, 0.95936E+00, 0.96885E+00, + & 0.97833E+00, 0.98778E+00, 0.99723E+00, 0.10067E+01, 0.10161E+01, + & 0.10255E+01, 0.10348E+01, 0.10442E+01, 0.10535E+01, 0.10629E+01, + & 0.10722E+01, 0.10815E+01, 0.10908E+01, 0.11000E+01, 0.11093E+01, + & 0.11185E+01, 0.11277E+01, 0.11369E+01, 0.11461E+01, 0.11552E+01, + & 0.11644E+01, 0.11735E+01, 0.11826E+01, 0.11917E+01, 0.12008E+01, + & 0.12098E+01, 0.12189E+01, 0.12279E+01, 0.12369E+01, 0.12459E+01, + & 0.12548E+01, 0.12638E+01, 0.12727E+01, 0.12816E+01, 0.12905E+01, + & 0.12994E+01, 0.13083E+01, 0.13171E+01, 0.13259E+01, 0.13347E+01, + & 0.13435E+01, 0.13523E+01, 0.13610E+01, 0.13698E+01, 0.13785E+01, + & 0.13872E+01, 0.13958E+01, 0.14045E+01, 0.14131E+01, 0.14218E+01, + & 0.14304E+01, 0.14390E+01, 0.14475E+01, 0.14561E+01, 0.14646E+01/ + + DATA (BNC11M (I),I=201,300)/ + & 0.14731E+01, 0.14816E+01, 0.14901E+01, 0.14986E+01, 0.15070E+01, + & 0.15154E+01, 0.15238E+01, 0.15322E+01, 0.15406E+01, 0.15489E+01, + & 0.15573E+01, 0.15656E+01, 0.15739E+01, 0.15822E+01, 0.15904E+01, + & 0.15987E+01, 0.16069E+01, 0.16151E+01, 0.16233E+01, 0.16315E+01, + & 0.16397E+01, 0.16478E+01, 0.16559E+01, 0.16640E+01, 0.16721E+01, + & 0.16802E+01, 0.16882E+01, 0.16963E+01, 0.17043E+01, 0.17123E+01, + & 0.17203E+01, 0.17283E+01, 0.17362E+01, 0.17441E+01, 0.17521E+01, + & 0.17600E+01, 0.17678E+01, 0.17757E+01, 0.17836E+01, 0.17914E+01, + & 0.17992E+01, 0.18070E+01, 0.18148E+01, 0.18226E+01, 0.18303E+01, + & 0.18380E+01, 0.18458E+01, 0.18535E+01, 0.18611E+01, 0.18688E+01, + & 0.18765E+01, 0.18841E+01, 0.18917E+01, 0.18993E+01, 0.19069E+01, + & 0.19145E+01, 0.19220E+01, 0.19296E+01, 0.19371E+01, 0.19446E+01, + & 0.19521E+01, 0.19596E+01, 0.19670E+01, 0.19745E+01, 0.19819E+01, + & 0.19893E+01, 0.19967E+01, 0.20041E+01, 0.20114E+01, 0.20188E+01, + & 0.20261E+01, 0.20334E+01, 0.20407E+01, 0.20480E+01, 0.20553E+01, + & 0.20626E+01, 0.20698E+01, 0.20770E+01, 0.20842E+01, 0.20914E+01, + & 0.20986E+01, 0.21058E+01, 0.21129E+01, 0.21201E+01, 0.21272E+01, + & 0.21343E+01, 0.21414E+01, 0.21485E+01, 0.21555E+01, 0.21626E+01, + & 0.21696E+01, 0.21767E+01, 0.21837E+01, 0.21907E+01, 0.21976E+01, + & 0.22046E+01, 0.22115E+01, 0.22185E+01, 0.22254E+01, 0.22323E+01/ + + DATA (BNC11M (I),I=301,400)/ + & 0.22392E+01, 0.22461E+01, 0.22529E+01, 0.22598E+01, 0.22666E+01, + & 0.22735E+01, 0.22803E+01, 0.22871E+01, 0.22938E+01, 0.23006E+01, + & 0.23074E+01, 0.23141E+01, 0.23208E+01, 0.23276E+01, 0.23343E+01, + & 0.23409E+01, 0.23476E+01, 0.23543E+01, 0.23609E+01, 0.23676E+01, + & 0.23742E+01, 0.23808E+01, 0.23874E+01, 0.23940E+01, 0.24005E+01, + & 0.24071E+01, 0.24136E+01, 0.24202E+01, 0.24267E+01, 0.24332E+01, + & 0.24397E+01, 0.24462E+01, 0.24526E+01, 0.24591E+01, 0.24655E+01, + & 0.24719E+01, 0.24784E+01, 0.24848E+01, 0.24912E+01, 0.24975E+01, + & 0.25039E+01, 0.25103E+01, 0.25166E+01, 0.25229E+01, 0.25292E+01, + & 0.25356E+01, 0.25418E+01, 0.25481E+01, 0.25544E+01, 0.25607E+01, + & 0.25669E+01, 0.25731E+01, 0.25794E+01, 0.25856E+01, 0.25918E+01, + & 0.25979E+01, 0.26041E+01, 0.26103E+01, 0.26164E+01, 0.26226E+01, + & 0.26287E+01, 0.26348E+01, 0.26409E+01, 0.26470E+01, 0.26531E+01, + & 0.26592E+01, 0.26652E+01, 0.26713E+01, 0.26773E+01, 0.26833E+01, + & 0.26894E+01, 0.26954E+01, 0.27013E+01, 0.27073E+01, 0.27133E+01, + & 0.27193E+01, 0.27252E+01, 0.27311E+01, 0.27371E+01, 0.27430E+01, + & 0.27489E+01, 0.27548E+01, 0.27607E+01, 0.27665E+01, 0.27724E+01, + & 0.27782E+01, 0.27841E+01, 0.27899E+01, 0.27957E+01, 0.28015E+01, + & 0.28073E+01, 0.28131E+01, 0.28189E+01, 0.28247E+01, 0.28304E+01, + & 0.28362E+01, 0.28419E+01, 0.28476E+01, 0.28533E+01, 0.28590E+01/ + + DATA (BNC11M (I),I=401,500)/ + & 0.28647E+01, 0.28704E+01, 0.28761E+01, 0.28817E+01, 0.28874E+01, + & 0.28930E+01, 0.28987E+01, 0.29043E+01, 0.29099E+01, 0.29155E+01, + & 0.29211E+01, 0.29267E+01, 0.29323E+01, 0.29378E+01, 0.29434E+01, + & 0.29489E+01, 0.29544E+01, 0.29600E+01, 0.29655E+01, 0.29710E+01, + & 0.29765E+01, 0.29820E+01, 0.29874E+01, 0.29929E+01, 0.29984E+01, + & 0.30038E+01, 0.30093E+01, 0.30147E+01, 0.30201E+01, 0.30255E+01, + & 0.30309E+01, 0.30363E+01, 0.30417E+01, 0.30471E+01, 0.30524E+01, + & 0.30578E+01, 0.30631E+01, 0.30685E+01, 0.30738E+01, 0.30791E+01, + & 0.30844E+01, 0.30897E+01, 0.30950E+01, 0.31003E+01, 0.31056E+01, + & 0.31108E+01, 0.31161E+01, 0.31213E+01, 0.31266E+01, 0.31318E+01, + & 0.31370E+01, 0.31422E+01, 0.31474E+01, 0.31526E+01, 0.31578E+01, + & 0.31630E+01, 0.31681E+01, 0.31733E+01, 0.31785E+01, 0.31836E+01, + & 0.31887E+01, 0.31939E+01, 0.31990E+01, 0.32041E+01, 0.32092E+01, + & 0.32143E+01, 0.32194E+01, 0.32244E+01, 0.32295E+01, 0.32345E+01, + & 0.32396E+01, 0.32446E+01, 0.32497E+01, 0.32547E+01, 0.32597E+01, + & 0.32647E+01, 0.32697E+01, 0.32747E+01, 0.32797E+01, 0.32847E+01, + & 0.32896E+01, 0.32946E+01, 0.32995E+01, 0.33045E+01, 0.33094E+01, + & 0.33144E+01, 0.33193E+01, 0.33242E+01, 0.33291E+01, 0.33340E+01, + & 0.33389E+01, 0.33438E+01, 0.33486E+01, 0.33535E+01, 0.33583E+01, + & 0.33632E+01, 0.33680E+01, 0.33729E+01, 0.33777E+01, 0.33825E+01/ + + DATA (BNC11M (I),I=501,600)/ + & 0.33873E+01, 0.33921E+01, 0.33969E+01, 0.34017E+01, 0.34065E+01, + & 0.34113E+01, 0.34160E+01, 0.34208E+01, 0.34255E+01, 0.34303E+01, + & 0.34350E+01, 0.34398E+01, 0.34445E+01, 0.34492E+01, 0.34539E+01, + & 0.34586E+01, 0.34633E+01, 0.34680E+01, 0.34726E+01, 0.34773E+01, + & 0.34820E+01, 0.34866E+01, 0.34913E+01, 0.34959E+01, 0.35006E+01, + & 0.35052E+01, 0.35098E+01, 0.35144E+01, 0.35190E+01, 0.35236E+01, + & 0.35282E+01, 0.35328E+01, 0.35374E+01, 0.35419E+01, 0.35465E+01, + & 0.35511E+01, 0.35556E+01, 0.35602E+01, 0.35647E+01, 0.35692E+01, + & 0.35737E+01, 0.35783E+01, 0.35828E+01, 0.35873E+01, 0.35918E+01, + & 0.35963E+01, 0.36007E+01, 0.36052E+01, 0.36097E+01, 0.36141E+01, + & 0.36186E+01, 0.36230E+01, 0.36275E+01, 0.36319E+01, 0.36363E+01, + & 0.36408E+01, 0.36452E+01, 0.36496E+01, 0.36540E+01, 0.36584E+01, + & 0.36628E+01, 0.36672E+01, 0.36715E+01, 0.36759E+01, 0.36803E+01, + & 0.36846E+01, 0.36890E+01, 0.36933E+01, 0.36977E+01, 0.37020E+01, + & 0.37063E+01, 0.37106E+01, 0.37150E+01, 0.37193E+01, 0.37236E+01, + & 0.37279E+01, 0.37321E+01, 0.37364E+01, 0.37407E+01, 0.37450E+01, + & 0.37492E+01, 0.37535E+01, 0.37577E+01, 0.37620E+01, 0.37662E+01, + & 0.37704E+01, 0.37747E+01, 0.37789E+01, 0.37831E+01, 0.37873E+01, + & 0.37915E+01, 0.37957E+01, 0.37999E+01, 0.38041E+01, 0.38083E+01, + & 0.38124E+01, 0.38166E+01, 0.38208E+01, 0.38249E+01, 0.38404E+01/ + + DATA (BNC11M (I),I=601,700)/ + & 0.38743E+01, 0.39148E+01, 0.39548E+01, 0.39942E+01, 0.40331E+01, + & 0.40715E+01, 0.41094E+01, 0.41467E+01, 0.41836E+01, 0.42200E+01, + & 0.42560E+01, 0.42915E+01, 0.43265E+01, 0.43611E+01, 0.43953E+01, + & 0.44291E+01, 0.44624E+01, 0.44954E+01, 0.45280E+01, 0.45601E+01, + & 0.45919E+01, 0.46234E+01, 0.46544E+01, 0.46852E+01, 0.47155E+01, + & 0.47456E+01, 0.47752E+01, 0.48046E+01, 0.48336E+01, 0.48624E+01, + & 0.48908E+01, 0.49189E+01, 0.49467E+01, 0.49742E+01, 0.50014E+01, + & 0.50283E+01, 0.50550E+01, 0.50814E+01, 0.51075E+01, 0.51333E+01, + & 0.51589E+01, 0.51842E+01, 0.52093E+01, 0.52341E+01, 0.52587E+01, + & 0.52830E+01, 0.53071E+01, 0.53309E+01, 0.53546E+01, 0.53780E+01, + & 0.54011E+01, 0.54241E+01, 0.54468E+01, 0.54694E+01, 0.54917E+01, + & 0.55138E+01, 0.55357E+01, 0.55574E+01, 0.55789E+01, 0.56002E+01, + & 0.56214E+01, 0.56423E+01, 0.56630E+01, 0.56836E+01, 0.57040E+01, + & 0.57242E+01, 0.57442E+01, 0.57640E+01, 0.57837E+01, 0.58032E+01, + & 0.58226E+01, 0.58417E+01, 0.58608E+01, 0.58796E+01, 0.58983E+01, + & 0.59168E+01, 0.59352E+01, 0.59534E+01, 0.59715E+01, 0.59894E+01, + & 0.60072E+01, 0.60248E+01, 0.60423E+01, 0.60597E+01, 0.60769E+01, + & 0.60940E+01, 0.61109E+01, 0.61277E+01, 0.61444E+01, 0.61609E+01, + & 0.61773E+01, 0.61936E+01, 0.62097E+01, 0.62257E+01, 0.62416E+01, + & 0.62574E+01, 0.62731E+01, 0.62886E+01, 0.63040E+01, 0.63193E+01/ + + DATA (BNC11M(I),I=701,741)/ + & 0.63345E+01, 0.63496E+01, 0.63645E+01, 0.63794E+01, 0.63941E+01, + & 0.64087E+01, 0.64232E+01, 0.64376E+01, 0.64519E+01, 0.64661E+01, + & 0.64802E+01, 0.64942E+01, 0.65081E+01, 0.65218E+01, 0.65355E+01, + & 0.65491E+01, 0.65626E+01, 0.65760E+01, 0.65893E+01, 0.66025E+01, + & 0.66156E+01, 0.66286E+01, 0.66415E+01, 0.66543E+01, 0.66671E+01, + & 0.66797E+01, 0.66923E+01, 0.67047E+01, 0.67171E+01, 0.67294E+01, + & 0.67416E+01, 0.67538E+01, 0.67658E+01, 0.67778E+01, 0.67897E+01, + & 0.68015E+01, 0.68132E+01, 0.68248E+01, 0.68364E+01, 0.68479E+01, + & 0.68593E+01 + & / +C +C *** NaHSO4 +C + DATA (BNC12M (I),I= 1,100)/ + &-0.54197E-01,-0.94863E-01,-0.12098E+00,-0.13730E+00,-0.14889E+00, + &-0.15763E+00,-0.16443E+00,-0.16981E+00,-0.17410E+00,-0.17752E+00, + &-0.18023E+00,-0.18234E+00,-0.18394E+00,-0.18510E+00,-0.18586E+00, + &-0.18627E+00,-0.18636E+00,-0.18617E+00,-0.18572E+00,-0.18502E+00, + &-0.18410E+00,-0.18297E+00,-0.18165E+00,-0.18014E+00,-0.17847E+00, + &-0.17662E+00,-0.17463E+00,-0.17249E+00,-0.17021E+00,-0.16779E+00, + &-0.16525E+00,-0.16259E+00,-0.15982E+00,-0.15693E+00,-0.15394E+00, + &-0.15084E+00,-0.14765E+00,-0.14437E+00,-0.14099E+00,-0.13753E+00, + &-0.13399E+00,-0.13037E+00,-0.12667E+00,-0.12290E+00,-0.11906E+00, + &-0.11516E+00,-0.11118E+00,-0.10715E+00,-0.10306E+00,-0.98908E-01, + &-0.94703E-01,-0.90443E-01,-0.86133E-01,-0.81773E-01,-0.77365E-01, + &-0.72910E-01,-0.68410E-01,-0.63866E-01,-0.59280E-01,-0.54651E-01, + &-0.49983E-01,-0.45274E-01,-0.40525E-01,-0.35739E-01,-0.30914E-01, + &-0.26051E-01,-0.21151E-01,-0.16213E-01,-0.11239E-01,-0.62276E-02, + &-0.11793E-02, 0.39061E-02, 0.90287E-02, 0.14188E-01, 0.19386E-01, + & 0.24620E-01, 0.29893E-01, 0.35204E-01, 0.40552E-01, 0.45940E-01, + & 0.51365E-01, 0.56830E-01, 0.62333E-01, 0.67875E-01, 0.73455E-01, + & 0.79074E-01, 0.84733E-01, 0.90428E-01, 0.96163E-01, 0.10193E+00, + & 0.10774E+00, 0.11359E+00, 0.11947E+00, 0.12539E+00, 0.13134E+00, + & 0.13732E+00, 0.14334E+00, 0.14939E+00, 0.15547E+00, 0.16158E+00/ + + DATA (BNC12M (I),I=101,200)/ + & 0.16772E+00, 0.17388E+00, 0.18007E+00, 0.18628E+00, 0.19252E+00, + & 0.19878E+00, 0.20506E+00, 0.21136E+00, 0.21768E+00, 0.22401E+00, + & 0.23036E+00, 0.23672E+00, 0.24309E+00, 0.24947E+00, 0.25587E+00, + & 0.26227E+00, 0.26867E+00, 0.27509E+00, 0.28150E+00, 0.28793E+00, + & 0.29372E+00, 0.30022E+00, 0.30671E+00, 0.31319E+00, 0.31967E+00, + & 0.32613E+00, 0.33259E+00, 0.33904E+00, 0.34548E+00, 0.35192E+00, + & 0.35834E+00, 0.36475E+00, 0.37116E+00, 0.37755E+00, 0.38393E+00, + & 0.39031E+00, 0.39667E+00, 0.40302E+00, 0.40936E+00, 0.41569E+00, + & 0.42201E+00, 0.42832E+00, 0.43461E+00, 0.44090E+00, 0.44717E+00, + & 0.45343E+00, 0.45968E+00, 0.46592E+00, 0.47214E+00, 0.47835E+00, + & 0.48455E+00, 0.49074E+00, 0.49691E+00, 0.50307E+00, 0.50922E+00, + & 0.51536E+00, 0.52148E+00, 0.52759E+00, 0.53369E+00, 0.53978E+00, + & 0.54585E+00, 0.55191E+00, 0.55795E+00, 0.56398E+00, 0.57000E+00, + & 0.57601E+00, 0.58200E+00, 0.58798E+00, 0.59395E+00, 0.59990E+00, + & 0.60584E+00, 0.61177E+00, 0.61768E+00, 0.62358E+00, 0.62947E+00, + & 0.63534E+00, 0.64120E+00, 0.64705E+00, 0.65288E+00, 0.65870E+00, + & 0.66451E+00, 0.67030E+00, 0.67608E+00, 0.68185E+00, 0.68761E+00, + & 0.69335E+00, 0.69907E+00, 0.70479E+00, 0.71049E+00, 0.71618E+00, + & 0.72185E+00, 0.72752E+00, 0.73317E+00, 0.73880E+00, 0.74442E+00, + & 0.75003E+00, 0.75563E+00, 0.76122E+00, 0.76679E+00, 0.77235E+00/ + + DATA (BNC12M (I),I=201,300)/ + & 0.77789E+00, 0.78342E+00, 0.78894E+00, 0.79445E+00, 0.79995E+00, + & 0.80543E+00, 0.81090E+00, 0.81635E+00, 0.82180E+00, 0.82723E+00, + & 0.83265E+00, 0.83806E+00, 0.84345E+00, 0.84883E+00, 0.85420E+00, + & 0.85956E+00, 0.86490E+00, 0.87023E+00, 0.87556E+00, 0.88086E+00, + & 0.88616E+00, 0.89144E+00, 0.89671E+00, 0.90197E+00, 0.90722E+00, + & 0.91246E+00, 0.91768E+00, 0.92289E+00, 0.92809E+00, 0.93328E+00, + & 0.93846E+00, 0.94362E+00, 0.94878E+00, 0.95392E+00, 0.95905E+00, + & 0.96417E+00, 0.96928E+00, 0.97437E+00, 0.97946E+00, 0.98453E+00, + & 0.98959E+00, 0.99464E+00, 0.99968E+00, 0.10047E+01, 0.10097E+01, + & 0.10147E+01, 0.10197E+01, 0.10247E+01, 0.10297E+01, 0.10346E+01, + & 0.10396E+01, 0.10445E+01, 0.10495E+01, 0.10544E+01, 0.10593E+01, + & 0.10642E+01, 0.10691E+01, 0.10739E+01, 0.10788E+01, 0.10836E+01, + & 0.10885E+01, 0.10933E+01, 0.10981E+01, 0.11030E+01, 0.11078E+01, + & 0.11125E+01, 0.11173E+01, 0.11221E+01, 0.11269E+01, 0.11316E+01, + & 0.11363E+01, 0.11411E+01, 0.11458E+01, 0.11505E+01, 0.11552E+01, + & 0.11599E+01, 0.11646E+01, 0.11692E+01, 0.11739E+01, 0.11785E+01, + & 0.11832E+01, 0.11878E+01, 0.11924E+01, 0.11970E+01, 0.12016E+01, + & 0.12062E+01, 0.12108E+01, 0.12154E+01, 0.12199E+01, 0.12245E+01, + & 0.12290E+01, 0.12335E+01, 0.12381E+01, 0.12426E+01, 0.12471E+01, + & 0.12516E+01, 0.12561E+01, 0.12605E+01, 0.12650E+01, 0.12695E+01/ + + DATA (BNC12M (I),I=301,400)/ + & 0.12739E+01, 0.12784E+01, 0.12828E+01, 0.12872E+01, 0.12916E+01, + & 0.12960E+01, 0.13004E+01, 0.13048E+01, 0.13092E+01, 0.13135E+01, + & 0.13179E+01, 0.13222E+01, 0.13266E+01, 0.13309E+01, 0.13352E+01, + & 0.13396E+01, 0.13439E+01, 0.13482E+01, 0.13524E+01, 0.13567E+01, + & 0.13610E+01, 0.13653E+01, 0.13695E+01, 0.13738E+01, 0.13780E+01, + & 0.13822E+01, 0.13864E+01, 0.13907E+01, 0.13949E+01, 0.13990E+01, + & 0.14032E+01, 0.14074E+01, 0.14116E+01, 0.14157E+01, 0.14199E+01, + & 0.14240E+01, 0.14282E+01, 0.14323E+01, 0.14364E+01, 0.14405E+01, + & 0.14447E+01, 0.14487E+01, 0.14528E+01, 0.14569E+01, 0.14610E+01, + & 0.14651E+01, 0.14691E+01, 0.14732E+01, 0.14772E+01, 0.14812E+01, + & 0.14853E+01, 0.14893E+01, 0.14933E+01, 0.14973E+01, 0.15013E+01, + & 0.15053E+01, 0.15093E+01, 0.15132E+01, 0.15172E+01, 0.15212E+01, + & 0.15251E+01, 0.15290E+01, 0.15330E+01, 0.15369E+01, 0.15408E+01, + & 0.15447E+01, 0.15486E+01, 0.15525E+01, 0.15564E+01, 0.15603E+01, + & 0.15642E+01, 0.15681E+01, 0.15719E+01, 0.15758E+01, 0.15796E+01, + & 0.15835E+01, 0.15873E+01, 0.15911E+01, 0.15949E+01, 0.15988E+01, + & 0.16026E+01, 0.16064E+01, 0.16101E+01, 0.16139E+01, 0.16177E+01, + & 0.16215E+01, 0.16252E+01, 0.16290E+01, 0.16327E+01, 0.16365E+01, + & 0.16402E+01, 0.16439E+01, 0.16477E+01, 0.16514E+01, 0.16551E+01, + & 0.16588E+01, 0.16625E+01, 0.16662E+01, 0.16699E+01, 0.16735E+01/ + + DATA (BNC12M (I),I=401,500)/ + & 0.16772E+01, 0.16809E+01, 0.16845E+01, 0.16882E+01, 0.16918E+01, + & 0.16954E+01, 0.16991E+01, 0.17027E+01, 0.17063E+01, 0.17099E+01, + & 0.17135E+01, 0.17171E+01, 0.17207E+01, 0.17243E+01, 0.17279E+01, + & 0.17314E+01, 0.17350E+01, 0.17386E+01, 0.17421E+01, 0.17456E+01, + & 0.17492E+01, 0.17527E+01, 0.17562E+01, 0.17598E+01, 0.17633E+01, + & 0.17668E+01, 0.17703E+01, 0.17738E+01, 0.17773E+01, 0.17808E+01, + & 0.17842E+01, 0.17877E+01, 0.17912E+01, 0.17946E+01, 0.17981E+01, + & 0.18015E+01, 0.18050E+01, 0.18084E+01, 0.18118E+01, 0.18153E+01, + & 0.18187E+01, 0.18221E+01, 0.18255E+01, 0.18289E+01, 0.18323E+01, + & 0.18357E+01, 0.18391E+01, 0.18424E+01, 0.18458E+01, 0.18492E+01, + & 0.18525E+01, 0.18559E+01, 0.18592E+01, 0.18626E+01, 0.18659E+01, + & 0.18693E+01, 0.18726E+01, 0.18759E+01, 0.18792E+01, 0.18825E+01, + & 0.18858E+01, 0.18891E+01, 0.18924E+01, 0.18957E+01, 0.18990E+01, + & 0.19023E+01, 0.19055E+01, 0.19088E+01, 0.19121E+01, 0.19153E+01, + & 0.19186E+01, 0.19218E+01, 0.19250E+01, 0.19283E+01, 0.19315E+01, + & 0.19347E+01, 0.19379E+01, 0.19411E+01, 0.19443E+01, 0.19475E+01, + & 0.19507E+01, 0.19539E+01, 0.19571E+01, 0.19603E+01, 0.19635E+01, + & 0.19666E+01, 0.19698E+01, 0.19730E+01, 0.19761E+01, 0.19793E+01, + & 0.19824E+01, 0.19855E+01, 0.19887E+01, 0.19918E+01, 0.19949E+01, + & 0.19980E+01, 0.20012E+01, 0.20043E+01, 0.20074E+01, 0.20105E+01/ + + DATA (BNC12M (I),I=501,600)/ + & 0.20136E+01, 0.20166E+01, 0.20197E+01, 0.20228E+01, 0.20259E+01, + & 0.20289E+01, 0.20320E+01, 0.20351E+01, 0.20381E+01, 0.20412E+01, + & 0.20442E+01, 0.20472E+01, 0.20503E+01, 0.20533E+01, 0.20563E+01, + & 0.20593E+01, 0.20624E+01, 0.20654E+01, 0.20684E+01, 0.20714E+01, + & 0.20744E+01, 0.20774E+01, 0.20803E+01, 0.20833E+01, 0.20863E+01, + & 0.20893E+01, 0.20922E+01, 0.20952E+01, 0.20982E+01, 0.21011E+01, + & 0.21041E+01, 0.21070E+01, 0.21099E+01, 0.21129E+01, 0.21158E+01, + & 0.21187E+01, 0.21217E+01, 0.21246E+01, 0.21275E+01, 0.21304E+01, + & 0.21333E+01, 0.21362E+01, 0.21391E+01, 0.21420E+01, 0.21449E+01, + & 0.21477E+01, 0.21506E+01, 0.21535E+01, 0.21564E+01, 0.21592E+01, + & 0.21621E+01, 0.21649E+01, 0.21678E+01, 0.21706E+01, 0.21735E+01, + & 0.21763E+01, 0.21791E+01, 0.21820E+01, 0.21848E+01, 0.21876E+01, + & 0.21904E+01, 0.21932E+01, 0.21960E+01, 0.21988E+01, 0.22016E+01, + & 0.22044E+01, 0.22072E+01, 0.22100E+01, 0.22128E+01, 0.22156E+01, + & 0.22183E+01, 0.22211E+01, 0.22239E+01, 0.22266E+01, 0.22294E+01, + & 0.22321E+01, 0.22349E+01, 0.22376E+01, 0.22404E+01, 0.22431E+01, + & 0.22458E+01, 0.22486E+01, 0.22513E+01, 0.22540E+01, 0.22567E+01, + & 0.22594E+01, 0.22621E+01, 0.22648E+01, 0.22675E+01, 0.22702E+01, + & 0.22729E+01, 0.22756E+01, 0.22783E+01, 0.22810E+01, 0.22836E+01, + & 0.22863E+01, 0.22890E+01, 0.22916E+01, 0.22943E+01, 0.23042E+01/ + + DATA (BNC12M (I),I=601,700)/ + & 0.23259E+01, 0.23518E+01, 0.23774E+01, 0.24026E+01, 0.24274E+01, + & 0.24519E+01, 0.24761E+01, 0.24999E+01, 0.25234E+01, 0.25466E+01, + & 0.25694E+01, 0.25920E+01, 0.26142E+01, 0.26362E+01, 0.26579E+01, + & 0.26793E+01, 0.27004E+01, 0.27213E+01, 0.27419E+01, 0.27622E+01, + & 0.27823E+01, 0.28022E+01, 0.28218E+01, 0.28411E+01, 0.28602E+01, + & 0.28791E+01, 0.28978E+01, 0.29162E+01, 0.29344E+01, 0.29524E+01, + & 0.29702E+01, 0.29878E+01, 0.30052E+01, 0.30224E+01, 0.30393E+01, + & 0.30561E+01, 0.30727E+01, 0.30891E+01, 0.31054E+01, 0.31214E+01, + & 0.31373E+01, 0.31530E+01, 0.31685E+01, 0.31838E+01, 0.31990E+01, + & 0.32140E+01, 0.32289E+01, 0.32436E+01, 0.32581E+01, 0.32725E+01, + & 0.32868E+01, 0.33008E+01, 0.33148E+01, 0.33286E+01, 0.33422E+01, + & 0.33557E+01, 0.33691E+01, 0.33823E+01, 0.33954E+01, 0.34084E+01, + & 0.34212E+01, 0.34339E+01, 0.34465E+01, 0.34589E+01, 0.34712E+01, + & 0.34834E+01, 0.34955E+01, 0.35075E+01, 0.35193E+01, 0.35310E+01, + & 0.35426E+01, 0.35541E+01, 0.35655E+01, 0.35768E+01, 0.35880E+01, + & 0.35990E+01, 0.36100E+01, 0.36208E+01, 0.36316E+01, 0.36422E+01, + & 0.36527E+01, 0.36632E+01, 0.36735E+01, 0.36838E+01, 0.36939E+01, + & 0.37040E+01, 0.37139E+01, 0.37238E+01, 0.37336E+01, 0.37432E+01, + & 0.37528E+01, 0.37623E+01, 0.37718E+01, 0.37811E+01, 0.37903E+01, + & 0.37995E+01, 0.38086E+01, 0.38176E+01, 0.38265E+01, 0.38353E+01/ + + DATA (BNC12M(I),I=701,741)/ + & 0.38441E+01, 0.38528E+01, 0.38614E+01, 0.38699E+01, 0.38783E+01, + & 0.38867E+01, 0.38950E+01, 0.39032E+01, 0.39113E+01, 0.39194E+01, + & 0.39274E+01, 0.39353E+01, 0.39432E+01, 0.39510E+01, 0.39587E+01, + & 0.39664E+01, 0.39740E+01, 0.39815E+01, 0.39889E+01, 0.39963E+01, + & 0.40037E+01, 0.40109E+01, 0.40181E+01, 0.40253E+01, 0.40323E+01, + & 0.40393E+01, 0.40463E+01, 0.40532E+01, 0.40600E+01, 0.40668E+01, + & 0.40735E+01, 0.40802E+01, 0.40867E+01, 0.40933E+01, 0.40998E+01, + & 0.41062E+01, 0.41126E+01, 0.41189E+01, 0.41252E+01, 0.41314E+01, + & 0.41375E+01 + & / +C +C *** (NH4)3H(SO4)2 +C + DATA (BNC13M (I),I= 1,100)/ + &-0.90602E-01,-0.16542E+00,-0.21853E+00,-0.25500E+00,-0.28333E+00, + &-0.30670E+00,-0.32669E+00,-0.34420E+00,-0.35982E+00,-0.37393E+00, + &-0.38682E+00,-0.39867E+00,-0.40966E+00,-0.41990E+00,-0.42949E+00, + &-0.43851E+00,-0.44702E+00,-0.45507E+00,-0.46272E+00,-0.46998E+00, + &-0.47691E+00,-0.48352E+00,-0.48985E+00,-0.49591E+00,-0.50172E+00, + &-0.50730E+00,-0.51266E+00,-0.51782E+00,-0.52278E+00,-0.52757E+00, + &-0.53219E+00,-0.53664E+00,-0.54094E+00,-0.54510E+00,-0.54912E+00, + &-0.55300E+00,-0.55676E+00,-0.56040E+00,-0.56392E+00,-0.56733E+00, + &-0.57064E+00,-0.57384E+00,-0.57695E+00,-0.57996E+00,-0.58289E+00, + &-0.58572E+00,-0.58848E+00,-0.59115E+00,-0.59374E+00,-0.59626E+00, + &-0.59871E+00,-0.60109E+00,-0.60340E+00,-0.60565E+00,-0.60784E+00, + &-0.60996E+00,-0.61203E+00,-0.61404E+00,-0.61599E+00,-0.61790E+00, + &-0.61975E+00,-0.62155E+00,-0.62331E+00,-0.62502E+00,-0.62668E+00, + &-0.62830E+00,-0.62988E+00,-0.63142E+00,-0.63291E+00,-0.63437E+00, + &-0.63579E+00,-0.63718E+00,-0.63852E+00,-0.63984E+00,-0.64111E+00, + &-0.64236E+00,-0.64357E+00,-0.64475E+00,-0.64590E+00,-0.64702E+00, + &-0.64811E+00,-0.64917E+00,-0.65020E+00,-0.65120E+00,-0.65217E+00, + &-0.65312E+00,-0.65404E+00,-0.65494E+00,-0.65581E+00,-0.65666E+00, + &-0.65748E+00,-0.65828E+00,-0.65905E+00,-0.65980E+00,-0.66053E+00, + &-0.66124E+00,-0.66193E+00,-0.66260E+00,-0.66324E+00,-0.66387E+00/ + + DATA (BNC13M (I),I=101,200)/ + &-0.66448E+00,-0.66507E+00,-0.66564E+00,-0.66620E+00,-0.66674E+00, + &-0.66726E+00,-0.66777E+00,-0.66827E+00,-0.66875E+00,-0.66921E+00, + &-0.66966E+00,-0.67010E+00,-0.67053E+00,-0.67095E+00,-0.67135E+00, + &-0.67175E+00,-0.67213E+00,-0.67250E+00,-0.67287E+00,-0.67322E+00, + &-0.67369E+00,-0.67401E+00,-0.67433E+00,-0.67464E+00,-0.67495E+00, + &-0.67525E+00,-0.67554E+00,-0.67583E+00,-0.67611E+00,-0.67639E+00, + &-0.67667E+00,-0.67694E+00,-0.67720E+00,-0.67746E+00,-0.67772E+00, + &-0.67797E+00,-0.67822E+00,-0.67847E+00,-0.67871E+00,-0.67895E+00, + &-0.67919E+00,-0.67942E+00,-0.67965E+00,-0.67988E+00,-0.68011E+00, + &-0.68033E+00,-0.68055E+00,-0.68077E+00,-0.68099E+00,-0.68120E+00, + &-0.68141E+00,-0.68162E+00,-0.68183E+00,-0.68204E+00,-0.68224E+00, + &-0.68245E+00,-0.68265E+00,-0.68285E+00,-0.68305E+00,-0.68325E+00, + &-0.68345E+00,-0.68365E+00,-0.68384E+00,-0.68404E+00,-0.68423E+00, + &-0.68442E+00,-0.68462E+00,-0.68481E+00,-0.68500E+00,-0.68519E+00, + &-0.68538E+00,-0.68557E+00,-0.68576E+00,-0.68595E+00,-0.68614E+00, + &-0.68633E+00,-0.68651E+00,-0.68670E+00,-0.68689E+00,-0.68708E+00, + &-0.68727E+00,-0.68745E+00,-0.68764E+00,-0.68783E+00,-0.68802E+00, + &-0.68820E+00,-0.68839E+00,-0.68858E+00,-0.68877E+00,-0.68896E+00, + &-0.68914E+00,-0.68933E+00,-0.68952E+00,-0.68971E+00,-0.68990E+00, + &-0.69009E+00,-0.69028E+00,-0.69047E+00,-0.69066E+00,-0.69085E+00/ + + DATA (BNC13M (I),I=201,300)/ + &-0.69105E+00,-0.69124E+00,-0.69143E+00,-0.69162E+00,-0.69182E+00, + &-0.69201E+00,-0.69221E+00,-0.69240E+00,-0.69260E+00,-0.69280E+00, + &-0.69299E+00,-0.69319E+00,-0.69339E+00,-0.69359E+00,-0.69379E+00, + &-0.69399E+00,-0.69419E+00,-0.69439E+00,-0.69459E+00,-0.69480E+00, + &-0.69500E+00,-0.69520E+00,-0.69541E+00,-0.69561E+00,-0.69582E+00, + &-0.69603E+00,-0.69624E+00,-0.69644E+00,-0.69665E+00,-0.69686E+00, + &-0.69707E+00,-0.69729E+00,-0.69750E+00,-0.69771E+00,-0.69793E+00, + &-0.69814E+00,-0.69836E+00,-0.69857E+00,-0.69879E+00,-0.69901E+00, + &-0.69923E+00,-0.69945E+00,-0.69967E+00,-0.69989E+00,-0.70011E+00, + &-0.70034E+00,-0.70056E+00,-0.70078E+00,-0.70101E+00,-0.70124E+00, + &-0.70146E+00,-0.70169E+00,-0.70192E+00,-0.70215E+00,-0.70238E+00, + &-0.70261E+00,-0.70285E+00,-0.70308E+00,-0.70331E+00,-0.70355E+00, + &-0.70379E+00,-0.70402E+00,-0.70426E+00,-0.70450E+00,-0.70474E+00, + &-0.70498E+00,-0.70522E+00,-0.70546E+00,-0.70571E+00,-0.70595E+00, + &-0.70619E+00,-0.70644E+00,-0.70669E+00,-0.70693E+00,-0.70718E+00, + &-0.70743E+00,-0.70768E+00,-0.70793E+00,-0.70818E+00,-0.70844E+00, + &-0.70869E+00,-0.70895E+00,-0.70920E+00,-0.70946E+00,-0.70971E+00, + &-0.70997E+00,-0.71023E+00,-0.71049E+00,-0.71075E+00,-0.71101E+00, + &-0.71128E+00,-0.71154E+00,-0.71180E+00,-0.71207E+00,-0.71234E+00, + &-0.71260E+00,-0.71287E+00,-0.71314E+00,-0.71341E+00,-0.71368E+00/ + + DATA (BNC13M (I),I=301,400)/ + &-0.71395E+00,-0.71422E+00,-0.71450E+00,-0.71477E+00,-0.71505E+00, + &-0.71532E+00,-0.71560E+00,-0.71588E+00,-0.71615E+00,-0.71643E+00, + &-0.71671E+00,-0.71699E+00,-0.71728E+00,-0.71756E+00,-0.71784E+00, + &-0.71813E+00,-0.71841E+00,-0.71870E+00,-0.71899E+00,-0.71927E+00, + &-0.71956E+00,-0.71985E+00,-0.72014E+00,-0.72043E+00,-0.72073E+00, + &-0.72102E+00,-0.72131E+00,-0.72161E+00,-0.72190E+00,-0.72220E+00, + &-0.72250E+00,-0.72280E+00,-0.72310E+00,-0.72340E+00,-0.72370E+00, + &-0.72400E+00,-0.72430E+00,-0.72460E+00,-0.72491E+00,-0.72521E+00, + &-0.72552E+00,-0.72583E+00,-0.72613E+00,-0.72644E+00,-0.72675E+00, + &-0.72706E+00,-0.72737E+00,-0.72768E+00,-0.72799E+00,-0.72831E+00, + &-0.72862E+00,-0.72894E+00,-0.72925E+00,-0.72957E+00,-0.72989E+00, + &-0.73020E+00,-0.73052E+00,-0.73084E+00,-0.73116E+00,-0.73149E+00, + &-0.73181E+00,-0.73213E+00,-0.73245E+00,-0.73278E+00,-0.73310E+00, + &-0.73343E+00,-0.73376E+00,-0.73409E+00,-0.73441E+00,-0.73474E+00, + &-0.73507E+00,-0.73540E+00,-0.73574E+00,-0.73607E+00,-0.73640E+00, + &-0.73674E+00,-0.73707E+00,-0.73741E+00,-0.73774E+00,-0.73808E+00, + &-0.73842E+00,-0.73876E+00,-0.73910E+00,-0.73944E+00,-0.73978E+00, + &-0.74012E+00,-0.74046E+00,-0.74081E+00,-0.74115E+00,-0.74150E+00, + &-0.74184E+00,-0.74219E+00,-0.74253E+00,-0.74288E+00,-0.74323E+00, + &-0.74358E+00,-0.74393E+00,-0.74428E+00,-0.74463E+00,-0.74499E+00/ + + DATA (BNC13M (I),I=401,500)/ + &-0.74534E+00,-0.74569E+00,-0.74605E+00,-0.74640E+00,-0.74676E+00, + &-0.74712E+00,-0.74747E+00,-0.74783E+00,-0.74819E+00,-0.74855E+00, + &-0.74891E+00,-0.74927E+00,-0.74964E+00,-0.75000E+00,-0.75036E+00, + &-0.75073E+00,-0.75109E+00,-0.75146E+00,-0.75182E+00,-0.75219E+00, + &-0.75256E+00,-0.75293E+00,-0.75330E+00,-0.75367E+00,-0.75404E+00, + &-0.75441E+00,-0.75478E+00,-0.75515E+00,-0.75553E+00,-0.75590E+00, + &-0.75627E+00,-0.75665E+00,-0.75703E+00,-0.75740E+00,-0.75778E+00, + &-0.75816E+00,-0.75854E+00,-0.75892E+00,-0.75930E+00,-0.75968E+00, + &-0.76006E+00,-0.76044E+00,-0.76083E+00,-0.76121E+00,-0.76160E+00, + &-0.76198E+00,-0.76237E+00,-0.76275E+00,-0.76314E+00,-0.76353E+00, + &-0.76392E+00,-0.76431E+00,-0.76470E+00,-0.76509E+00,-0.76548E+00, + &-0.76587E+00,-0.76626E+00,-0.76666E+00,-0.76705E+00,-0.76744E+00, + &-0.76784E+00,-0.76824E+00,-0.76863E+00,-0.76903E+00,-0.76943E+00, + &-0.76983E+00,-0.77023E+00,-0.77063E+00,-0.77103E+00,-0.77143E+00, + &-0.77183E+00,-0.77223E+00,-0.77263E+00,-0.77304E+00,-0.77344E+00, + &-0.77385E+00,-0.77425E+00,-0.77466E+00,-0.77507E+00,-0.77547E+00, + &-0.77588E+00,-0.77629E+00,-0.77670E+00,-0.77711E+00,-0.77752E+00, + &-0.77793E+00,-0.77834E+00,-0.77876E+00,-0.77917E+00,-0.77958E+00, + &-0.78000E+00,-0.78041E+00,-0.78083E+00,-0.78124E+00,-0.78166E+00, + &-0.78208E+00,-0.78249E+00,-0.78291E+00,-0.78333E+00,-0.78375E+00/ + + DATA (BNC13M (I),I=501,600)/ + &-0.78417E+00,-0.78459E+00,-0.78502E+00,-0.78544E+00,-0.78586E+00, + &-0.78628E+00,-0.78671E+00,-0.78713E+00,-0.78756E+00,-0.78798E+00, + &-0.78841E+00,-0.78884E+00,-0.78926E+00,-0.78969E+00,-0.79012E+00, + &-0.79055E+00,-0.79098E+00,-0.79141E+00,-0.79184E+00,-0.79227E+00, + &-0.79271E+00,-0.79314E+00,-0.79357E+00,-0.79401E+00,-0.79444E+00, + &-0.79488E+00,-0.79531E+00,-0.79575E+00,-0.79619E+00,-0.79662E+00, + &-0.79706E+00,-0.79750E+00,-0.79794E+00,-0.79838E+00,-0.79882E+00, + &-0.79926E+00,-0.79970E+00,-0.80014E+00,-0.80058E+00,-0.80103E+00, + &-0.80147E+00,-0.80192E+00,-0.80236E+00,-0.80281E+00,-0.80325E+00, + &-0.80370E+00,-0.80414E+00,-0.80459E+00,-0.80504E+00,-0.80549E+00, + &-0.80594E+00,-0.80639E+00,-0.80684E+00,-0.80729E+00,-0.80774E+00, + &-0.80819E+00,-0.80864E+00,-0.80910E+00,-0.80955E+00,-0.81000E+00, + &-0.81046E+00,-0.81091E+00,-0.81137E+00,-0.81182E+00,-0.81228E+00, + &-0.81274E+00,-0.81320E+00,-0.81365E+00,-0.81411E+00,-0.81457E+00, + &-0.81503E+00,-0.81549E+00,-0.81595E+00,-0.81641E+00,-0.81688E+00, + &-0.81734E+00,-0.81780E+00,-0.81826E+00,-0.81873E+00,-0.81919E+00, + &-0.81966E+00,-0.82012E+00,-0.82059E+00,-0.82105E+00,-0.82152E+00, + &-0.82199E+00,-0.82246E+00,-0.82293E+00,-0.82339E+00,-0.82386E+00, + &-0.82433E+00,-0.82480E+00,-0.82528E+00,-0.82575E+00,-0.82622E+00, + &-0.82669E+00,-0.82716E+00,-0.82764E+00,-0.82811E+00,-0.82989E+00/ + + DATA (BNC13M (I),I=601,700)/ + &-0.83384E+00,-0.83866E+00,-0.84353E+00,-0.84845E+00,-0.85341E+00, + &-0.85841E+00,-0.86346E+00,-0.86856E+00,-0.87369E+00,-0.87886E+00, + &-0.88408E+00,-0.88933E+00,-0.89463E+00,-0.89996E+00,-0.90532E+00, + &-0.91073E+00,-0.91617E+00,-0.92164E+00,-0.92715E+00,-0.93270E+00, + &-0.93828E+00,-0.94389E+00,-0.94953E+00,-0.95520E+00,-0.96091E+00, + &-0.96664E+00,-0.97241E+00,-0.97820E+00,-0.98402E+00,-0.98987E+00, + &-0.99575E+00,-0.10017E+01,-0.10076E+01,-0.10136E+01,-0.10195E+01, + &-0.10256E+01,-0.10316E+01,-0.10377E+01,-0.10437E+01,-0.10499E+01, + &-0.10560E+01,-0.10621E+01,-0.10683E+01,-0.10745E+01,-0.10808E+01, + &-0.10870E+01,-0.10933E+01,-0.10996E+01,-0.11059E+01,-0.11122E+01, + &-0.11186E+01,-0.11249E+01,-0.11313E+01,-0.11377E+01,-0.11442E+01, + &-0.11506E+01,-0.11571E+01,-0.11636E+01,-0.11701E+01,-0.11766E+01, + &-0.11831E+01,-0.11897E+01,-0.11963E+01,-0.12028E+01,-0.12095E+01, + &-0.12161E+01,-0.12227E+01,-0.12294E+01,-0.12360E+01,-0.12427E+01, + &-0.12494E+01,-0.12561E+01,-0.12629E+01,-0.12696E+01,-0.12764E+01, + &-0.12831E+01,-0.12899E+01,-0.12967E+01,-0.13035E+01,-0.13104E+01, + &-0.13172E+01,-0.13241E+01,-0.13309E+01,-0.13378E+01,-0.13447E+01, + &-0.13516E+01,-0.13585E+01,-0.13655E+01,-0.13724E+01,-0.13794E+01, + &-0.13863E+01,-0.13933E+01,-0.14003E+01,-0.14073E+01,-0.14143E+01, + &-0.14213E+01,-0.14284E+01,-0.14354E+01,-0.14424E+01,-0.14495E+01/ + + DATA (BNC13M(I),I=701,741)/ + &-0.14566E+01,-0.14637E+01,-0.14708E+01,-0.14779E+01,-0.14850E+01, + &-0.14921E+01,-0.14992E+01,-0.15064E+01,-0.15135E+01,-0.15207E+01, + &-0.15279E+01,-0.15351E+01,-0.15422E+01,-0.15494E+01,-0.15567E+01, + &-0.15639E+01,-0.15711E+01,-0.15783E+01,-0.15856E+01,-0.15928E+01, + &-0.16001E+01,-0.16073E+01,-0.16146E+01,-0.16219E+01,-0.16292E+01, + &-0.16365E+01,-0.16438E+01,-0.16511E+01,-0.16584E+01,-0.16657E+01, + &-0.16731E+01,-0.16804E+01,-0.16878E+01,-0.16951E+01,-0.17025E+01, + &-0.17099E+01,-0.17172E+01,-0.17246E+01,-0.17320E+01,-0.17394E+01, + &-0.17468E+01 + & / + END + +C *** TEMP = 223.0 + + BLOCK DATA KMCF223 +C +C *** Common block definition +C + COMMON /KMC223/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) +C +C *** NaCl +C + DATA (BNC01M (I),I= 1,100)/ + &-0.53546E-01,-0.94317E-01,-0.12065E+00,-0.13711E+00,-0.14879E+00, + &-0.15760E+00,-0.16447E+00,-0.16993E+00,-0.17432E+00,-0.17787E+00, + &-0.18074E+00,-0.18305E+00,-0.18490E+00,-0.18635E+00,-0.18746E+00, + &-0.18827E+00,-0.18883E+00,-0.18916E+00,-0.18929E+00,-0.18925E+00, + &-0.18904E+00,-0.18869E+00,-0.18822E+00,-0.18763E+00,-0.18693E+00, + &-0.18614E+00,-0.18527E+00,-0.18432E+00,-0.18330E+00,-0.18222E+00, + &-0.18107E+00,-0.17988E+00,-0.17864E+00,-0.17735E+00,-0.17603E+00, + &-0.17467E+00,-0.17328E+00,-0.17186E+00,-0.17042E+00,-0.16895E+00, + &-0.16746E+00,-0.16595E+00,-0.16443E+00,-0.16289E+00,-0.16134E+00, + &-0.15977E+00,-0.15820E+00,-0.15661E+00,-0.15502E+00,-0.15342E+00, + &-0.15181E+00,-0.15020E+00,-0.14859E+00,-0.14696E+00,-0.14534E+00, + &-0.14371E+00,-0.14207E+00,-0.14043E+00,-0.13879E+00,-0.13714E+00, + &-0.13549E+00,-0.13383E+00,-0.13217E+00,-0.13051E+00,-0.12883E+00, + &-0.12716E+00,-0.12547E+00,-0.12378E+00,-0.12208E+00,-0.12038E+00, + &-0.11866E+00,-0.11694E+00,-0.11520E+00,-0.11346E+00,-0.11170E+00, + &-0.10993E+00,-0.10816E+00,-0.10636E+00,-0.10456E+00,-0.10274E+00, + &-0.10091E+00,-0.99060E-01,-0.97198E-01,-0.95320E-01,-0.93428E-01, + &-0.91520E-01,-0.89596E-01,-0.87656E-01,-0.85700E-01,-0.83729E-01, + &-0.81741E-01,-0.79737E-01,-0.77718E-01,-0.75682E-01,-0.73632E-01, + &-0.71566E-01,-0.69486E-01,-0.67391E-01,-0.65281E-01,-0.63158E-01/ + + DATA (BNC01M (I),I=101,200)/ + &-0.61022E-01,-0.58873E-01,-0.56711E-01,-0.54538E-01,-0.52353E-01, + &-0.50157E-01,-0.47951E-01,-0.45735E-01,-0.43510E-01,-0.41276E-01, + &-0.39034E-01,-0.36785E-01,-0.34529E-01,-0.32266E-01,-0.29997E-01, + &-0.27722E-01,-0.25443E-01,-0.23159E-01,-0.20871E-01,-0.18579E-01, + &-0.16586E-01,-0.14254E-01,-0.11922E-01,-0.95920E-02,-0.72631E-02, + &-0.49355E-02,-0.26095E-02,-0.28486E-03, 0.20382E-02, 0.43595E-02, + & 0.66792E-02, 0.89971E-02, 0.11313E-01, 0.13627E-01, 0.15940E-01, + & 0.18250E-01, 0.20558E-01, 0.22864E-01, 0.25168E-01, 0.27470E-01, + & 0.29770E-01, 0.32067E-01, 0.34362E-01, 0.36654E-01, 0.38945E-01, + & 0.41232E-01, 0.43517E-01, 0.45800E-01, 0.48080E-01, 0.50357E-01, + & 0.52632E-01, 0.54904E-01, 0.57174E-01, 0.59440E-01, 0.61704E-01, + & 0.63965E-01, 0.66223E-01, 0.68479E-01, 0.70731E-01, 0.72981E-01, + & 0.75227E-01, 0.77471E-01, 0.79711E-01, 0.81949E-01, 0.84183E-01, + & 0.86415E-01, 0.88643E-01, 0.90868E-01, 0.93091E-01, 0.95310E-01, + & 0.97525E-01, 0.99738E-01, 0.10195E+00, 0.10415E+00, 0.10636E+00, + & 0.10856E+00, 0.11075E+00, 0.11295E+00, 0.11514E+00, 0.11732E+00, + & 0.11950E+00, 0.12168E+00, 0.12386E+00, 0.12603E+00, 0.12820E+00, + & 0.13037E+00, 0.13253E+00, 0.13469E+00, 0.13685E+00, 0.13900E+00, + & 0.14115E+00, 0.14330E+00, 0.14544E+00, 0.14758E+00, 0.14971E+00, + & 0.15184E+00, 0.15397E+00, 0.15610E+00, 0.15822E+00, 0.16034E+00/ + + DATA (BNC01M (I),I=201,300)/ + & 0.16245E+00, 0.16456E+00, 0.16667E+00, 0.16877E+00, 0.17087E+00, + & 0.17297E+00, 0.17506E+00, 0.17715E+00, 0.17924E+00, 0.18132E+00, + & 0.18340E+00, 0.18548E+00, 0.18755E+00, 0.18962E+00, 0.19168E+00, + & 0.19374E+00, 0.19580E+00, 0.19786E+00, 0.19991E+00, 0.20195E+00, + & 0.20400E+00, 0.20604E+00, 0.20807E+00, 0.21011E+00, 0.21213E+00, + & 0.21416E+00, 0.21618E+00, 0.21820E+00, 0.22022E+00, 0.22223E+00, + & 0.22423E+00, 0.22624E+00, 0.22824E+00, 0.23024E+00, 0.23223E+00, + & 0.23422E+00, 0.23621E+00, 0.23819E+00, 0.24017E+00, 0.24214E+00, + & 0.24412E+00, 0.24608E+00, 0.24805E+00, 0.25001E+00, 0.25197E+00, + & 0.25392E+00, 0.25587E+00, 0.25782E+00, 0.25977E+00, 0.26171E+00, + & 0.26364E+00, 0.26558E+00, 0.26751E+00, 0.26943E+00, 0.27135E+00, + & 0.27327E+00, 0.27519E+00, 0.27710E+00, 0.27901E+00, 0.28092E+00, + & 0.28282E+00, 0.28472E+00, 0.28661E+00, 0.28850E+00, 0.29039E+00, + & 0.29227E+00, 0.29415E+00, 0.29603E+00, 0.29791E+00, 0.29978E+00, + & 0.30164E+00, 0.30351E+00, 0.30537E+00, 0.30722E+00, 0.30908E+00, + & 0.31093E+00, 0.31277E+00, 0.31462E+00, 0.31646E+00, 0.31829E+00, + & 0.32013E+00, 0.32196E+00, 0.32378E+00, 0.32561E+00, 0.32743E+00, + & 0.32924E+00, 0.33105E+00, 0.33286E+00, 0.33467E+00, 0.33647E+00, + & 0.33827E+00, 0.34007E+00, 0.34186E+00, 0.34365E+00, 0.34544E+00, + & 0.34722E+00, 0.34900E+00, 0.35078E+00, 0.35255E+00, 0.35432E+00/ + + DATA (BNC01M (I),I=301,400)/ + & 0.35608E+00, 0.35785E+00, 0.35961E+00, 0.36136E+00, 0.36312E+00, + & 0.36487E+00, 0.36661E+00, 0.36836E+00, 0.37010E+00, 0.37184E+00, + & 0.37357E+00, 0.37530E+00, 0.37703E+00, 0.37875E+00, 0.38047E+00, + & 0.38219E+00, 0.38391E+00, 0.38562E+00, 0.38733E+00, 0.38903E+00, + & 0.39073E+00, 0.39243E+00, 0.39413E+00, 0.39582E+00, 0.39751E+00, + & 0.39920E+00, 0.40088E+00, 0.40256E+00, 0.40424E+00, 0.40591E+00, + & 0.40758E+00, 0.40925E+00, 0.41092E+00, 0.41258E+00, 0.41424E+00, + & 0.41589E+00, 0.41755E+00, 0.41920E+00, 0.42084E+00, 0.42249E+00, + & 0.42413E+00, 0.42576E+00, 0.42740E+00, 0.42903E+00, 0.43066E+00, + & 0.43228E+00, 0.43391E+00, 0.43553E+00, 0.43714E+00, 0.43876E+00, + & 0.44037E+00, 0.44197E+00, 0.44358E+00, 0.44518E+00, 0.44678E+00, + & 0.44837E+00, 0.44997E+00, 0.45156E+00, 0.45315E+00, 0.45473E+00, + & 0.45631E+00, 0.45789E+00, 0.45946E+00, 0.46104E+00, 0.46261E+00, + & 0.46417E+00, 0.46574E+00, 0.46730E+00, 0.46886E+00, 0.47041E+00, + & 0.47197E+00, 0.47352E+00, 0.47506E+00, 0.47661E+00, 0.47815E+00, + & 0.47969E+00, 0.48122E+00, 0.48276E+00, 0.48429E+00, 0.48581E+00, + & 0.48734E+00, 0.48886E+00, 0.49038E+00, 0.49190E+00, 0.49341E+00, + & 0.49492E+00, 0.49643E+00, 0.49794E+00, 0.49944E+00, 0.50094E+00, + & 0.50244E+00, 0.50393E+00, 0.50542E+00, 0.50691E+00, 0.50840E+00, + & 0.50988E+00, 0.51136E+00, 0.51284E+00, 0.51432E+00, 0.51579E+00/ + + DATA (BNC01M (I),I=401,500)/ + & 0.51726E+00, 0.51873E+00, 0.52019E+00, 0.52166E+00, 0.52312E+00, + & 0.52457E+00, 0.52603E+00, 0.52748E+00, 0.52893E+00, 0.53038E+00, + & 0.53182E+00, 0.53326E+00, 0.53470E+00, 0.53614E+00, 0.53758E+00, + & 0.53901E+00, 0.54044E+00, 0.54186E+00, 0.54329E+00, 0.54471E+00, + & 0.54613E+00, 0.54754E+00, 0.54896E+00, 0.55037E+00, 0.55178E+00, + & 0.55318E+00, 0.55459E+00, 0.55599E+00, 0.55739E+00, 0.55878E+00, + & 0.56018E+00, 0.56157E+00, 0.56296E+00, 0.56434E+00, 0.56573E+00, + & 0.56711E+00, 0.56849E+00, 0.56987E+00, 0.57124E+00, 0.57261E+00, + & 0.57398E+00, 0.57535E+00, 0.57671E+00, 0.57808E+00, 0.57944E+00, + & 0.58079E+00, 0.58215E+00, 0.58350E+00, 0.58485E+00, 0.58620E+00, + & 0.58755E+00, 0.58889E+00, 0.59023E+00, 0.59157E+00, 0.59290E+00, + & 0.59424E+00, 0.59557E+00, 0.59690E+00, 0.59823E+00, 0.59955E+00, + & 0.60087E+00, 0.60219E+00, 0.60351E+00, 0.60483E+00, 0.60614E+00, + & 0.60745E+00, 0.60876E+00, 0.61006E+00, 0.61137E+00, 0.61267E+00, + & 0.61397E+00, 0.61527E+00, 0.61656E+00, 0.61786E+00, 0.61915E+00, + & 0.62043E+00, 0.62172E+00, 0.62300E+00, 0.62429E+00, 0.62557E+00, + & 0.62684E+00, 0.62812E+00, 0.62939E+00, 0.63066E+00, 0.63193E+00, + & 0.63320E+00, 0.63446E+00, 0.63572E+00, 0.63698E+00, 0.63824E+00, + & 0.63949E+00, 0.64075E+00, 0.64200E+00, 0.64325E+00, 0.64449E+00, + & 0.64574E+00, 0.64698E+00, 0.64822E+00, 0.64946E+00, 0.65070E+00/ + + DATA (BNC01M (I),I=501,600)/ + & 0.65193E+00, 0.65316E+00, 0.65439E+00, 0.65562E+00, 0.65685E+00, + & 0.65807E+00, 0.65929E+00, 0.66051E+00, 0.66173E+00, 0.66294E+00, + & 0.66416E+00, 0.66537E+00, 0.66658E+00, 0.66779E+00, 0.66899E+00, + & 0.67019E+00, 0.67139E+00, 0.67259E+00, 0.67379E+00, 0.67499E+00, + & 0.67618E+00, 0.67737E+00, 0.67856E+00, 0.67975E+00, 0.68093E+00, + & 0.68211E+00, 0.68329E+00, 0.68447E+00, 0.68565E+00, 0.68683E+00, + & 0.68800E+00, 0.68917E+00, 0.69034E+00, 0.69151E+00, 0.69267E+00, + & 0.69383E+00, 0.69500E+00, 0.69616E+00, 0.69731E+00, 0.69847E+00, + & 0.69962E+00, 0.70077E+00, 0.70192E+00, 0.70307E+00, 0.70422E+00, + & 0.70536E+00, 0.70650E+00, 0.70764E+00, 0.70878E+00, 0.70992E+00, + & 0.71105E+00, 0.71219E+00, 0.71332E+00, 0.71445E+00, 0.71557E+00, + & 0.71670E+00, 0.71782E+00, 0.71894E+00, 0.72006E+00, 0.72118E+00, + & 0.72230E+00, 0.72341E+00, 0.72452E+00, 0.72563E+00, 0.72674E+00, + & 0.72785E+00, 0.72895E+00, 0.73006E+00, 0.73116E+00, 0.73226E+00, + & 0.73335E+00, 0.73445E+00, 0.73554E+00, 0.73664E+00, 0.73773E+00, + & 0.73882E+00, 0.73990E+00, 0.74099E+00, 0.74207E+00, 0.74315E+00, + & 0.74423E+00, 0.74531E+00, 0.74639E+00, 0.74746E+00, 0.74853E+00, + & 0.74961E+00, 0.75067E+00, 0.75174E+00, 0.75281E+00, 0.75387E+00, + & 0.75493E+00, 0.75600E+00, 0.75705E+00, 0.75811E+00, 0.75917E+00, + & 0.76022E+00, 0.76127E+00, 0.76232E+00, 0.76337E+00, 0.76729E+00/ + + DATA (BNC01M (I),I=601,700)/ + & 0.77583E+00, 0.78602E+00, 0.79605E+00, 0.80593E+00, 0.81565E+00, + & 0.82522E+00, 0.83463E+00, 0.84391E+00, 0.85304E+00, 0.86203E+00, + & 0.87088E+00, 0.87959E+00, 0.88818E+00, 0.89663E+00, 0.90496E+00, + & 0.91316E+00, 0.92124E+00, 0.92920E+00, 0.93704E+00, 0.94477E+00, + & 0.95238E+00, 0.95988E+00, 0.96727E+00, 0.97455E+00, 0.98173E+00, + & 0.98880E+00, 0.99577E+00, 0.10026E+01, 0.10094E+01, 0.10161E+01, + & 0.10227E+01, 0.10292E+01, 0.10355E+01, 0.10418E+01, 0.10481E+01, + & 0.10542E+01, 0.10602E+01, 0.10662E+01, 0.10721E+01, 0.10778E+01, + & 0.10836E+01, 0.10892E+01, 0.10947E+01, 0.11002E+01, 0.11056E+01, + & 0.11109E+01, 0.11162E+01, 0.11213E+01, 0.11264E+01, 0.11315E+01, + & 0.11364E+01, 0.11413E+01, 0.11462E+01, 0.11509E+01, 0.11556E+01, + & 0.11603E+01, 0.11648E+01, 0.11693E+01, 0.11738E+01, 0.11782E+01, + & 0.11825E+01, 0.11867E+01, 0.11909E+01, 0.11951E+01, 0.11992E+01, + & 0.12032E+01, 0.12072E+01, 0.12111E+01, 0.12150E+01, 0.12188E+01, + & 0.12226E+01, 0.12263E+01, 0.12299E+01, 0.12335E+01, 0.12371E+01, + & 0.12406E+01, 0.12441E+01, 0.12475E+01, 0.12508E+01, 0.12542E+01, + & 0.12574E+01, 0.12607E+01, 0.12638E+01, 0.12670E+01, 0.12701E+01, + & 0.12731E+01, 0.12761E+01, 0.12791E+01, 0.12820E+01, 0.12849E+01, + & 0.12877E+01, 0.12905E+01, 0.12933E+01, 0.12960E+01, 0.12987E+01, + & 0.13013E+01, 0.13039E+01, 0.13065E+01, 0.13090E+01, 0.13115E+01/ + + DATA (BNC01M(I),I=701,741)/ + & 0.13139E+01, 0.13163E+01, 0.13187E+01, 0.13211E+01, 0.13234E+01, + & 0.13256E+01, 0.13279E+01, 0.13301E+01, 0.13323E+01, 0.13344E+01, + & 0.13365E+01, 0.13386E+01, 0.13406E+01, 0.13426E+01, 0.13446E+01, + & 0.13465E+01, 0.13485E+01, 0.13503E+01, 0.13522E+01, 0.13540E+01, + & 0.13558E+01, 0.13576E+01, 0.13593E+01, 0.13610E+01, 0.13627E+01, + & 0.13643E+01, 0.13660E+01, 0.13675E+01, 0.13691E+01, 0.13706E+01, + & 0.13722E+01, 0.13736E+01, 0.13751E+01, 0.13765E+01, 0.13779E+01, + & 0.13793E+01, 0.13807E+01, 0.13820E+01, 0.13833E+01, 0.13846E+01, + & 0.13858E+01 + & / +C +C *** Na2SO4 +C + DATA (BNC02M (I),I= 1,100)/ + &-0.11119E+00,-0.20367E+00,-0.26963E+00,-0.31506E+00,-0.35045E+00, + &-0.37972E+00,-0.40481E+00,-0.42685E+00,-0.44655E+00,-0.46441E+00, + &-0.48077E+00,-0.49588E+00,-0.50994E+00,-0.52310E+00,-0.53548E+00, + &-0.54717E+00,-0.55826E+00,-0.56881E+00,-0.57888E+00,-0.58852E+00, + &-0.59777E+00,-0.60666E+00,-0.61522E+00,-0.62348E+00,-0.63147E+00, + &-0.63919E+00,-0.64669E+00,-0.65396E+00,-0.66102E+00,-0.66789E+00, + &-0.67458E+00,-0.68110E+00,-0.68746E+00,-0.69367E+00,-0.69974E+00, + &-0.70567E+00,-0.71147E+00,-0.71716E+00,-0.72272E+00,-0.72818E+00, + &-0.73353E+00,-0.73878E+00,-0.74393E+00,-0.74900E+00,-0.75397E+00, + &-0.75886E+00,-0.76367E+00,-0.76841E+00,-0.77307E+00,-0.77765E+00, + &-0.78217E+00,-0.78662E+00,-0.79101E+00,-0.79534E+00,-0.79961E+00, + &-0.80382E+00,-0.80798E+00,-0.81208E+00,-0.81613E+00,-0.82013E+00, + &-0.82409E+00,-0.82799E+00,-0.83186E+00,-0.83568E+00,-0.83946E+00, + &-0.84320E+00,-0.84690E+00,-0.85056E+00,-0.85419E+00,-0.85778E+00, + &-0.86133E+00,-0.86486E+00,-0.86835E+00,-0.87181E+00,-0.87525E+00, + &-0.87865E+00,-0.88202E+00,-0.88537E+00,-0.88869E+00,-0.89199E+00, + &-0.89526E+00,-0.89851E+00,-0.90173E+00,-0.90493E+00,-0.90811E+00, + &-0.91127E+00,-0.91441E+00,-0.91753E+00,-0.92063E+00,-0.92370E+00, + &-0.92676E+00,-0.92981E+00,-0.93283E+00,-0.93584E+00,-0.93883E+00, + &-0.94180E+00,-0.94476E+00,-0.94770E+00,-0.95062E+00,-0.95353E+00/ + + DATA (BNC02M (I),I=101,200)/ + &-0.95642E+00,-0.95930E+00,-0.96217E+00,-0.96502E+00,-0.96786E+00, + &-0.97068E+00,-0.97349E+00,-0.97628E+00,-0.97907E+00,-0.98184E+00, + &-0.98459E+00,-0.98733E+00,-0.99007E+00,-0.99278E+00,-0.99549E+00, + &-0.99818E+00,-0.10009E+01,-0.10035E+01,-0.10062E+01,-0.10088E+01, + &-0.10114E+01,-0.10141E+01,-0.10167E+01,-0.10193E+01,-0.10219E+01, + &-0.10245E+01,-0.10270E+01,-0.10296E+01,-0.10321E+01,-0.10347E+01, + &-0.10372E+01,-0.10397E+01,-0.10422E+01,-0.10447E+01,-0.10472E+01, + &-0.10497E+01,-0.10522E+01,-0.10546E+01,-0.10571E+01,-0.10595E+01, + &-0.10620E+01,-0.10644E+01,-0.10668E+01,-0.10692E+01,-0.10716E+01, + &-0.10740E+01,-0.10764E+01,-0.10787E+01,-0.10811E+01,-0.10835E+01, + &-0.10858E+01,-0.10881E+01,-0.10905E+01,-0.10928E+01,-0.10951E+01, + &-0.10974E+01,-0.10997E+01,-0.11020E+01,-0.11043E+01,-0.11066E+01, + &-0.11088E+01,-0.11111E+01,-0.11134E+01,-0.11156E+01,-0.11179E+01, + &-0.11201E+01,-0.11223E+01,-0.11246E+01,-0.11268E+01,-0.11290E+01, + &-0.11312E+01,-0.11334E+01,-0.11356E+01,-0.11378E+01,-0.11399E+01, + &-0.11421E+01,-0.11443E+01,-0.11465E+01,-0.11486E+01,-0.11508E+01, + &-0.11529E+01,-0.11550E+01,-0.11572E+01,-0.11593E+01,-0.11614E+01, + &-0.11635E+01,-0.11657E+01,-0.11678E+01,-0.11699E+01,-0.11720E+01, + &-0.11740E+01,-0.11761E+01,-0.11782E+01,-0.11803E+01,-0.11824E+01, + &-0.11844E+01,-0.11865E+01,-0.11885E+01,-0.11906E+01,-0.11926E+01/ + + DATA (BNC02M (I),I=201,300)/ + &-0.11947E+01,-0.11967E+01,-0.11987E+01,-0.12008E+01,-0.12028E+01, + &-0.12048E+01,-0.12068E+01,-0.12088E+01,-0.12108E+01,-0.12128E+01, + &-0.12148E+01,-0.12168E+01,-0.12188E+01,-0.12208E+01,-0.12228E+01, + &-0.12247E+01,-0.12267E+01,-0.12287E+01,-0.12306E+01,-0.12326E+01, + &-0.12345E+01,-0.12365E+01,-0.12384E+01,-0.12404E+01,-0.12423E+01, + &-0.12443E+01,-0.12462E+01,-0.12481E+01,-0.12500E+01,-0.12520E+01, + &-0.12539E+01,-0.12558E+01,-0.12577E+01,-0.12596E+01,-0.12615E+01, + &-0.12634E+01,-0.12653E+01,-0.12672E+01,-0.12691E+01,-0.12710E+01, + &-0.12728E+01,-0.12747E+01,-0.12766E+01,-0.12785E+01,-0.12803E+01, + &-0.12822E+01,-0.12840E+01,-0.12859E+01,-0.12878E+01,-0.12896E+01, + &-0.12915E+01,-0.12933E+01,-0.12951E+01,-0.12970E+01,-0.12988E+01, + &-0.13006E+01,-0.13025E+01,-0.13043E+01,-0.13061E+01,-0.13079E+01, + &-0.13098E+01,-0.13116E+01,-0.13134E+01,-0.13152E+01,-0.13170E+01, + &-0.13188E+01,-0.13206E+01,-0.13224E+01,-0.13242E+01,-0.13260E+01, + &-0.13278E+01,-0.13296E+01,-0.13313E+01,-0.13331E+01,-0.13349E+01, + &-0.13367E+01,-0.13385E+01,-0.13402E+01,-0.13420E+01,-0.13438E+01, + &-0.13455E+01,-0.13473E+01,-0.13490E+01,-0.13508E+01,-0.13525E+01, + &-0.13543E+01,-0.13560E+01,-0.13578E+01,-0.13595E+01,-0.13613E+01, + &-0.13630E+01,-0.13647E+01,-0.13665E+01,-0.13682E+01,-0.13699E+01, + &-0.13717E+01,-0.13734E+01,-0.13751E+01,-0.13768E+01,-0.13785E+01/ + + DATA (BNC02M (I),I=301,400)/ + &-0.13802E+01,-0.13820E+01,-0.13837E+01,-0.13854E+01,-0.13871E+01, + &-0.13888E+01,-0.13905E+01,-0.13922E+01,-0.13939E+01,-0.13956E+01, + &-0.13973E+01,-0.13989E+01,-0.14006E+01,-0.14023E+01,-0.14040E+01, + &-0.14057E+01,-0.14074E+01,-0.14090E+01,-0.14107E+01,-0.14124E+01, + &-0.14141E+01,-0.14157E+01,-0.14174E+01,-0.14191E+01,-0.14207E+01, + &-0.14224E+01,-0.14240E+01,-0.14257E+01,-0.14274E+01,-0.14290E+01, + &-0.14307E+01,-0.14323E+01,-0.14340E+01,-0.14356E+01,-0.14372E+01, + &-0.14389E+01,-0.14405E+01,-0.14422E+01,-0.14438E+01,-0.14454E+01, + &-0.14471E+01,-0.14487E+01,-0.14503E+01,-0.14519E+01,-0.14536E+01, + &-0.14552E+01,-0.14568E+01,-0.14584E+01,-0.14601E+01,-0.14617E+01, + &-0.14633E+01,-0.14649E+01,-0.14665E+01,-0.14681E+01,-0.14697E+01, + &-0.14713E+01,-0.14729E+01,-0.14745E+01,-0.14761E+01,-0.14777E+01, + &-0.14793E+01,-0.14809E+01,-0.14825E+01,-0.14841E+01,-0.14857E+01, + &-0.14873E+01,-0.14889E+01,-0.14905E+01,-0.14921E+01,-0.14936E+01, + &-0.14952E+01,-0.14968E+01,-0.14984E+01,-0.15000E+01,-0.15015E+01, + &-0.15031E+01,-0.15047E+01,-0.15062E+01,-0.15078E+01,-0.15094E+01, + &-0.15110E+01,-0.15125E+01,-0.15141E+01,-0.15156E+01,-0.15172E+01, + &-0.15188E+01,-0.15203E+01,-0.15219E+01,-0.15234E+01,-0.15250E+01, + &-0.15265E+01,-0.15281E+01,-0.15296E+01,-0.15312E+01,-0.15327E+01, + &-0.15343E+01,-0.15358E+01,-0.15374E+01,-0.15389E+01,-0.15404E+01/ + + DATA (BNC02M (I),I=401,500)/ + &-0.15420E+01,-0.15435E+01,-0.15450E+01,-0.15466E+01,-0.15481E+01, + &-0.15496E+01,-0.15512E+01,-0.15527E+01,-0.15542E+01,-0.15557E+01, + &-0.15573E+01,-0.15588E+01,-0.15603E+01,-0.15618E+01,-0.15634E+01, + &-0.15649E+01,-0.15664E+01,-0.15679E+01,-0.15694E+01,-0.15709E+01, + &-0.15724E+01,-0.15740E+01,-0.15755E+01,-0.15770E+01,-0.15785E+01, + &-0.15800E+01,-0.15815E+01,-0.15830E+01,-0.15845E+01,-0.15860E+01, + &-0.15875E+01,-0.15890E+01,-0.15905E+01,-0.15920E+01,-0.15935E+01, + &-0.15950E+01,-0.15965E+01,-0.15979E+01,-0.15994E+01,-0.16009E+01, + &-0.16024E+01,-0.16039E+01,-0.16054E+01,-0.16069E+01,-0.16083E+01, + &-0.16098E+01,-0.16113E+01,-0.16128E+01,-0.16143E+01,-0.16157E+01, + &-0.16172E+01,-0.16187E+01,-0.16202E+01,-0.16216E+01,-0.16231E+01, + &-0.16246E+01,-0.16260E+01,-0.16275E+01,-0.16290E+01,-0.16305E+01, + &-0.16319E+01,-0.16334E+01,-0.16348E+01,-0.16363E+01,-0.16378E+01, + &-0.16392E+01,-0.16407E+01,-0.16421E+01,-0.16436E+01,-0.16451E+01, + &-0.16465E+01,-0.16480E+01,-0.16494E+01,-0.16509E+01,-0.16523E+01, + &-0.16538E+01,-0.16552E+01,-0.16567E+01,-0.16581E+01,-0.16596E+01, + &-0.16610E+01,-0.16624E+01,-0.16639E+01,-0.16653E+01,-0.16668E+01, + &-0.16682E+01,-0.16696E+01,-0.16711E+01,-0.16725E+01,-0.16739E+01, + &-0.16754E+01,-0.16768E+01,-0.16783E+01,-0.16797E+01,-0.16811E+01, + &-0.16825E+01,-0.16840E+01,-0.16854E+01,-0.16868E+01,-0.16883E+01/ + + DATA (BNC02M (I),I=501,600)/ + &-0.16897E+01,-0.16911E+01,-0.16925E+01,-0.16939E+01,-0.16954E+01, + &-0.16968E+01,-0.16982E+01,-0.16996E+01,-0.17010E+01,-0.17025E+01, + &-0.17039E+01,-0.17053E+01,-0.17067E+01,-0.17081E+01,-0.17095E+01, + &-0.17109E+01,-0.17124E+01,-0.17138E+01,-0.17152E+01,-0.17166E+01, + &-0.17180E+01,-0.17194E+01,-0.17208E+01,-0.17222E+01,-0.17236E+01, + &-0.17250E+01,-0.17264E+01,-0.17278E+01,-0.17292E+01,-0.17306E+01, + &-0.17320E+01,-0.17334E+01,-0.17348E+01,-0.17362E+01,-0.17376E+01, + &-0.17390E+01,-0.17404E+01,-0.17418E+01,-0.17432E+01,-0.17446E+01, + &-0.17460E+01,-0.17473E+01,-0.17487E+01,-0.17501E+01,-0.17515E+01, + &-0.17529E+01,-0.17543E+01,-0.17557E+01,-0.17571E+01,-0.17584E+01, + &-0.17598E+01,-0.17612E+01,-0.17626E+01,-0.17640E+01,-0.17653E+01, + &-0.17667E+01,-0.17681E+01,-0.17695E+01,-0.17709E+01,-0.17722E+01, + &-0.17736E+01,-0.17750E+01,-0.17764E+01,-0.17777E+01,-0.17791E+01, + &-0.17805E+01,-0.17818E+01,-0.17832E+01,-0.17846E+01,-0.17859E+01, + &-0.17873E+01,-0.17887E+01,-0.17900E+01,-0.17914E+01,-0.17928E+01, + &-0.17941E+01,-0.17955E+01,-0.17969E+01,-0.17982E+01,-0.17996E+01, + &-0.18009E+01,-0.18023E+01,-0.18037E+01,-0.18050E+01,-0.18064E+01, + &-0.18077E+01,-0.18091E+01,-0.18105E+01,-0.18118E+01,-0.18132E+01, + &-0.18145E+01,-0.18159E+01,-0.18172E+01,-0.18186E+01,-0.18199E+01, + &-0.18213E+01,-0.18226E+01,-0.18240E+01,-0.18253E+01,-0.18304E+01/ + + DATA (BNC02M (I),I=601,700)/ + &-0.18414E+01,-0.18548E+01,-0.18681E+01,-0.18813E+01,-0.18945E+01, + &-0.19076E+01,-0.19207E+01,-0.19337E+01,-0.19467E+01,-0.19596E+01, + &-0.19724E+01,-0.19852E+01,-0.19980E+01,-0.20107E+01,-0.20233E+01, + &-0.20359E+01,-0.20485E+01,-0.20610E+01,-0.20735E+01,-0.20859E+01, + &-0.20983E+01,-0.21107E+01,-0.21230E+01,-0.21353E+01,-0.21475E+01, + &-0.21598E+01,-0.21719E+01,-0.21841E+01,-0.21962E+01,-0.22082E+01, + &-0.22203E+01,-0.22323E+01,-0.22442E+01,-0.22562E+01,-0.22681E+01, + &-0.22800E+01,-0.22918E+01,-0.23036E+01,-0.23154E+01,-0.23272E+01, + &-0.23389E+01,-0.23506E+01,-0.23623E+01,-0.23740E+01,-0.23856E+01, + &-0.23972E+01,-0.24088E+01,-0.24204E+01,-0.24319E+01,-0.24434E+01, + &-0.24549E+01,-0.24663E+01,-0.24778E+01,-0.24892E+01,-0.25006E+01, + &-0.25119E+01,-0.25233E+01,-0.25346E+01,-0.25459E+01,-0.25572E+01, + &-0.25685E+01,-0.25797E+01,-0.25910E+01,-0.26022E+01,-0.26134E+01, + &-0.26245E+01,-0.26357E+01,-0.26468E+01,-0.26579E+01,-0.26690E+01, + &-0.26801E+01,-0.26912E+01,-0.27022E+01,-0.27132E+01,-0.27242E+01, + &-0.27352E+01,-0.27462E+01,-0.27572E+01,-0.27681E+01,-0.27790E+01, + &-0.27900E+01,-0.28009E+01,-0.28117E+01,-0.28226E+01,-0.28335E+01, + &-0.28443E+01,-0.28551E+01,-0.28659E+01,-0.28767E+01,-0.28875E+01, + &-0.28983E+01,-0.29090E+01,-0.29198E+01,-0.29305E+01,-0.29412E+01, + &-0.29519E+01,-0.29626E+01,-0.29733E+01,-0.29839E+01,-0.29946E+01/ + + DATA (BNC02M(I),I=701,741)/ + &-0.30052E+01,-0.30158E+01,-0.30264E+01,-0.30370E+01,-0.30476E+01, + &-0.30582E+01,-0.30688E+01,-0.30793E+01,-0.30899E+01,-0.31004E+01, + &-0.31109E+01,-0.31214E+01,-0.31319E+01,-0.31424E+01,-0.31529E+01, + &-0.31633E+01,-0.31738E+01,-0.31842E+01,-0.31946E+01,-0.32051E+01, + &-0.32155E+01,-0.32259E+01,-0.32363E+01,-0.32466E+01,-0.32570E+01, + &-0.32674E+01,-0.32777E+01,-0.32881E+01,-0.32984E+01,-0.33087E+01, + &-0.33190E+01,-0.33293E+01,-0.33396E+01,-0.33499E+01,-0.33602E+01, + &-0.33705E+01,-0.33807E+01,-0.33910E+01,-0.34012E+01,-0.34114E+01, + &-0.34217E+01 + & / +C +C *** NaNO3 +C + DATA (BNC03M (I),I= 1,100)/ + &-0.55791E-01,-0.10256E+00,-0.13620E+00,-0.15954E+00,-0.17783E+00, + &-0.19304E+00,-0.20616E+00,-0.21773E+00,-0.22813E+00,-0.23760E+00, + &-0.24630E+00,-0.25438E+00,-0.26192E+00,-0.26900E+00,-0.27569E+00, + &-0.28203E+00,-0.28806E+00,-0.29382E+00,-0.29933E+00,-0.30462E+00, + &-0.30971E+00,-0.31462E+00,-0.31936E+00,-0.32394E+00,-0.32838E+00, + &-0.33269E+00,-0.33687E+00,-0.34094E+00,-0.34490E+00,-0.34876E+00, + &-0.35252E+00,-0.35620E+00,-0.35979E+00,-0.36330E+00,-0.36674E+00, + &-0.37010E+00,-0.37340E+00,-0.37663E+00,-0.37979E+00,-0.38290E+00, + &-0.38596E+00,-0.38895E+00,-0.39190E+00,-0.39480E+00,-0.39764E+00, + &-0.40045E+00,-0.40320E+00,-0.40592E+00,-0.40859E+00,-0.41123E+00, + &-0.41383E+00,-0.41639E+00,-0.41891E+00,-0.42141E+00,-0.42387E+00, + &-0.42629E+00,-0.42869E+00,-0.43106E+00,-0.43340E+00,-0.43571E+00, + &-0.43799E+00,-0.44025E+00,-0.44249E+00,-0.44470E+00,-0.44689E+00, + &-0.44905E+00,-0.45120E+00,-0.45332E+00,-0.45543E+00,-0.45752E+00, + &-0.45958E+00,-0.46163E+00,-0.46367E+00,-0.46568E+00,-0.46768E+00, + &-0.46967E+00,-0.47164E+00,-0.47359E+00,-0.47554E+00,-0.47747E+00, + &-0.47938E+00,-0.48129E+00,-0.48318E+00,-0.48506E+00,-0.48693E+00, + &-0.48879E+00,-0.49064E+00,-0.49247E+00,-0.49430E+00,-0.49612E+00, + &-0.49793E+00,-0.49973E+00,-0.50152E+00,-0.50330E+00,-0.50508E+00, + &-0.50684E+00,-0.50860E+00,-0.51035E+00,-0.51209E+00,-0.51383E+00/ + + DATA (BNC03M (I),I=101,200)/ + &-0.51555E+00,-0.51727E+00,-0.51898E+00,-0.52069E+00,-0.52239E+00, + &-0.52408E+00,-0.52576E+00,-0.52743E+00,-0.52910E+00,-0.53077E+00, + &-0.53242E+00,-0.53407E+00,-0.53571E+00,-0.53735E+00,-0.53898E+00, + &-0.54060E+00,-0.54221E+00,-0.54382E+00,-0.54543E+00,-0.54702E+00, + &-0.54856E+00,-0.55015E+00,-0.55173E+00,-0.55331E+00,-0.55488E+00, + &-0.55644E+00,-0.55800E+00,-0.55955E+00,-0.56109E+00,-0.56263E+00, + &-0.56416E+00,-0.56568E+00,-0.56720E+00,-0.56871E+00,-0.57022E+00, + &-0.57172E+00,-0.57322E+00,-0.57471E+00,-0.57619E+00,-0.57767E+00, + &-0.57915E+00,-0.58061E+00,-0.58208E+00,-0.58353E+00,-0.58499E+00, + &-0.58643E+00,-0.58787E+00,-0.58931E+00,-0.59074E+00,-0.59217E+00, + &-0.59359E+00,-0.59501E+00,-0.59642E+00,-0.59783E+00,-0.59924E+00, + &-0.60063E+00,-0.60203E+00,-0.60342E+00,-0.60480E+00,-0.60619E+00, + &-0.60756E+00,-0.60893E+00,-0.61030E+00,-0.61167E+00,-0.61303E+00, + &-0.61438E+00,-0.61573E+00,-0.61708E+00,-0.61842E+00,-0.61976E+00, + &-0.62110E+00,-0.62243E+00,-0.62376E+00,-0.62508E+00,-0.62640E+00, + &-0.62772E+00,-0.62903E+00,-0.63034E+00,-0.63165E+00,-0.63295E+00, + &-0.63425E+00,-0.63554E+00,-0.63683E+00,-0.63812E+00,-0.63941E+00, + &-0.64069E+00,-0.64196E+00,-0.64324E+00,-0.64451E+00,-0.64578E+00, + &-0.64704E+00,-0.64830E+00,-0.64956E+00,-0.65082E+00,-0.65207E+00, + &-0.65332E+00,-0.65456E+00,-0.65580E+00,-0.65704E+00,-0.65828E+00/ + + DATA (BNC03M (I),I=201,300)/ + &-0.65951E+00,-0.66074E+00,-0.66197E+00,-0.66320E+00,-0.66442E+00, + &-0.66564E+00,-0.66685E+00,-0.66807E+00,-0.66928E+00,-0.67048E+00, + &-0.67169E+00,-0.67289E+00,-0.67409E+00,-0.67529E+00,-0.67648E+00, + &-0.67767E+00,-0.67886E+00,-0.68005E+00,-0.68123E+00,-0.68241E+00, + &-0.68359E+00,-0.68476E+00,-0.68594E+00,-0.68711E+00,-0.68828E+00, + &-0.68944E+00,-0.69060E+00,-0.69177E+00,-0.69292E+00,-0.69408E+00, + &-0.69523E+00,-0.69638E+00,-0.69753E+00,-0.69868E+00,-0.69983E+00, + &-0.70097E+00,-0.70211E+00,-0.70324E+00,-0.70438E+00,-0.70551E+00, + &-0.70664E+00,-0.70777E+00,-0.70890E+00,-0.71002E+00,-0.71115E+00, + &-0.71227E+00,-0.71338E+00,-0.71450E+00,-0.71561E+00,-0.71672E+00, + &-0.71783E+00,-0.71894E+00,-0.72005E+00,-0.72115E+00,-0.72225E+00, + &-0.72335E+00,-0.72445E+00,-0.72554E+00,-0.72664E+00,-0.72773E+00, + &-0.72882E+00,-0.72991E+00,-0.73099E+00,-0.73208E+00,-0.73316E+00, + &-0.73424E+00,-0.73532E+00,-0.73639E+00,-0.73747E+00,-0.73854E+00, + &-0.73961E+00,-0.74068E+00,-0.74175E+00,-0.74281E+00,-0.74388E+00, + &-0.74494E+00,-0.74600E+00,-0.74706E+00,-0.74811E+00,-0.74917E+00, + &-0.75022E+00,-0.75127E+00,-0.75232E+00,-0.75337E+00,-0.75442E+00, + &-0.75546E+00,-0.75651E+00,-0.75755E+00,-0.75859E+00,-0.75962E+00, + &-0.76066E+00,-0.76170E+00,-0.76273E+00,-0.76376E+00,-0.76479E+00, + &-0.76582E+00,-0.76685E+00,-0.76787E+00,-0.76890E+00,-0.76992E+00/ + + DATA (BNC03M (I),I=301,400)/ + &-0.77094E+00,-0.77196E+00,-0.77298E+00,-0.77399E+00,-0.77501E+00, + &-0.77602E+00,-0.77703E+00,-0.77804E+00,-0.77905E+00,-0.78006E+00, + &-0.78107E+00,-0.78207E+00,-0.78308E+00,-0.78408E+00,-0.78508E+00, + &-0.78608E+00,-0.78707E+00,-0.78807E+00,-0.78906E+00,-0.79006E+00, + &-0.79105E+00,-0.79204E+00,-0.79303E+00,-0.79402E+00,-0.79500E+00, + &-0.79599E+00,-0.79697E+00,-0.79796E+00,-0.79894E+00,-0.79992E+00, + &-0.80090E+00,-0.80187E+00,-0.80285E+00,-0.80382E+00,-0.80480E+00, + &-0.80577E+00,-0.80674E+00,-0.80771E+00,-0.80868E+00,-0.80965E+00, + &-0.81061E+00,-0.81158E+00,-0.81254E+00,-0.81350E+00,-0.81446E+00, + &-0.81542E+00,-0.81638E+00,-0.81734E+00,-0.81829E+00,-0.81925E+00, + &-0.82020E+00,-0.82116E+00,-0.82211E+00,-0.82306E+00,-0.82401E+00, + &-0.82496E+00,-0.82590E+00,-0.82685E+00,-0.82779E+00,-0.82874E+00, + &-0.82968E+00,-0.83062E+00,-0.83156E+00,-0.83250E+00,-0.83344E+00, + &-0.83437E+00,-0.83531E+00,-0.83624E+00,-0.83718E+00,-0.83811E+00, + &-0.83904E+00,-0.83997E+00,-0.84090E+00,-0.84183E+00,-0.84275E+00, + &-0.84368E+00,-0.84460E+00,-0.84553E+00,-0.84645E+00,-0.84737E+00, + &-0.84829E+00,-0.84921E+00,-0.85013E+00,-0.85105E+00,-0.85197E+00, + &-0.85288E+00,-0.85380E+00,-0.85471E+00,-0.85562E+00,-0.85653E+00, + &-0.85744E+00,-0.85835E+00,-0.85926E+00,-0.86017E+00,-0.86108E+00, + &-0.86198E+00,-0.86289E+00,-0.86379E+00,-0.86469E+00,-0.86560E+00/ + + DATA (BNC03M (I),I=401,500)/ + &-0.86650E+00,-0.86740E+00,-0.86830E+00,-0.86919E+00,-0.87009E+00, + &-0.87099E+00,-0.87188E+00,-0.87278E+00,-0.87367E+00,-0.87456E+00, + &-0.87545E+00,-0.87634E+00,-0.87723E+00,-0.87812E+00,-0.87901E+00, + &-0.87990E+00,-0.88078E+00,-0.88167E+00,-0.88255E+00,-0.88344E+00, + &-0.88432E+00,-0.88520E+00,-0.88608E+00,-0.88696E+00,-0.88784E+00, + &-0.88872E+00,-0.88960E+00,-0.89048E+00,-0.89135E+00,-0.89223E+00, + &-0.89310E+00,-0.89397E+00,-0.89485E+00,-0.89572E+00,-0.89659E+00, + &-0.89746E+00,-0.89833E+00,-0.89920E+00,-0.90006E+00,-0.90093E+00, + &-0.90180E+00,-0.90266E+00,-0.90353E+00,-0.90439E+00,-0.90525E+00, + &-0.90612E+00,-0.90698E+00,-0.90784E+00,-0.90870E+00,-0.90956E+00, + &-0.91041E+00,-0.91127E+00,-0.91213E+00,-0.91298E+00,-0.91384E+00, + &-0.91469E+00,-0.91555E+00,-0.91640E+00,-0.91725E+00,-0.91810E+00, + &-0.91895E+00,-0.91980E+00,-0.92065E+00,-0.92150E+00,-0.92235E+00, + &-0.92319E+00,-0.92404E+00,-0.92488E+00,-0.92573E+00,-0.92657E+00, + &-0.92742E+00,-0.92826E+00,-0.92910E+00,-0.92994E+00,-0.93078E+00, + &-0.93162E+00,-0.93246E+00,-0.93330E+00,-0.93413E+00,-0.93497E+00, + &-0.93581E+00,-0.93664E+00,-0.93748E+00,-0.93831E+00,-0.93914E+00, + &-0.93998E+00,-0.94081E+00,-0.94164E+00,-0.94247E+00,-0.94330E+00, + &-0.94413E+00,-0.94496E+00,-0.94578E+00,-0.94661E+00,-0.94744E+00, + &-0.94826E+00,-0.94909E+00,-0.94991E+00,-0.95074E+00,-0.95156E+00/ + + DATA (BNC03M (I),I=501,600)/ + &-0.95238E+00,-0.95320E+00,-0.95403E+00,-0.95485E+00,-0.95567E+00, + &-0.95649E+00,-0.95730E+00,-0.95812E+00,-0.95894E+00,-0.95976E+00, + &-0.96057E+00,-0.96139E+00,-0.96220E+00,-0.96302E+00,-0.96383E+00, + &-0.96464E+00,-0.96546E+00,-0.96627E+00,-0.96708E+00,-0.96789E+00, + &-0.96870E+00,-0.96951E+00,-0.97032E+00,-0.97113E+00,-0.97193E+00, + &-0.97274E+00,-0.97355E+00,-0.97435E+00,-0.97516E+00,-0.97596E+00, + &-0.97677E+00,-0.97757E+00,-0.97837E+00,-0.97917E+00,-0.97997E+00, + &-0.98078E+00,-0.98158E+00,-0.98238E+00,-0.98318E+00,-0.98397E+00, + &-0.98477E+00,-0.98557E+00,-0.98637E+00,-0.98716E+00,-0.98796E+00, + &-0.98875E+00,-0.98955E+00,-0.99034E+00,-0.99114E+00,-0.99193E+00, + &-0.99272E+00,-0.99351E+00,-0.99431E+00,-0.99510E+00,-0.99589E+00, + &-0.99668E+00,-0.99747E+00,-0.99825E+00,-0.99904E+00,-0.99983E+00, + &-0.10006E+01,-0.10014E+01,-0.10022E+01,-0.10030E+01,-0.10038E+01, + &-0.10045E+01,-0.10053E+01,-0.10061E+01,-0.10069E+01,-0.10077E+01, + &-0.10085E+01,-0.10092E+01,-0.10100E+01,-0.10108E+01,-0.10116E+01, + &-0.10124E+01,-0.10131E+01,-0.10139E+01,-0.10147E+01,-0.10155E+01, + &-0.10162E+01,-0.10170E+01,-0.10178E+01,-0.10186E+01,-0.10193E+01, + &-0.10201E+01,-0.10209E+01,-0.10217E+01,-0.10224E+01,-0.10232E+01, + &-0.10240E+01,-0.10248E+01,-0.10255E+01,-0.10263E+01,-0.10271E+01, + &-0.10278E+01,-0.10286E+01,-0.10294E+01,-0.10301E+01,-0.10330E+01/ + + DATA (BNC03M (I),I=601,700)/ + &-0.10393E+01,-0.10469E+01,-0.10545E+01,-0.10620E+01,-0.10694E+01, + &-0.10769E+01,-0.10842E+01,-0.10916E+01,-0.10989E+01,-0.11062E+01, + &-0.11134E+01,-0.11206E+01,-0.11277E+01,-0.11349E+01,-0.11420E+01, + &-0.11490E+01,-0.11560E+01,-0.11630E+01,-0.11700E+01,-0.11769E+01, + &-0.11838E+01,-0.11907E+01,-0.11976E+01,-0.12044E+01,-0.12112E+01, + &-0.12180E+01,-0.12247E+01,-0.12314E+01,-0.12381E+01,-0.12448E+01, + &-0.12514E+01,-0.12581E+01,-0.12647E+01,-0.12713E+01,-0.12778E+01, + &-0.12843E+01,-0.12909E+01,-0.12974E+01,-0.13038E+01,-0.13103E+01, + &-0.13167E+01,-0.13231E+01,-0.13295E+01,-0.13359E+01,-0.13423E+01, + &-0.13486E+01,-0.13549E+01,-0.13612E+01,-0.13675E+01,-0.13738E+01, + &-0.13800E+01,-0.13863E+01,-0.13925E+01,-0.13987E+01,-0.14049E+01, + &-0.14111E+01,-0.14172E+01,-0.14234E+01,-0.14295E+01,-0.14356E+01, + &-0.14417E+01,-0.14478E+01,-0.14539E+01,-0.14599E+01,-0.14660E+01, + &-0.14720E+01,-0.14780E+01,-0.14840E+01,-0.14900E+01,-0.14960E+01, + &-0.15020E+01,-0.15079E+01,-0.15139E+01,-0.15198E+01,-0.15257E+01, + &-0.15316E+01,-0.15375E+01,-0.15434E+01,-0.15493E+01,-0.15551E+01, + &-0.15610E+01,-0.15668E+01,-0.15727E+01,-0.15785E+01,-0.15843E+01, + &-0.15901E+01,-0.15959E+01,-0.16017E+01,-0.16074E+01,-0.16132E+01, + &-0.16189E+01,-0.16247E+01,-0.16304E+01,-0.16361E+01,-0.16418E+01, + &-0.16475E+01,-0.16532E+01,-0.16589E+01,-0.16646E+01,-0.16703E+01/ + + DATA (BNC03M(I),I=701,741)/ + &-0.16759E+01,-0.16816E+01,-0.16872E+01,-0.16928E+01,-0.16985E+01, + &-0.17041E+01,-0.17097E+01,-0.17153E+01,-0.17209E+01,-0.17265E+01, + &-0.17320E+01,-0.17376E+01,-0.17432E+01,-0.17487E+01,-0.17543E+01, + &-0.17598E+01,-0.17653E+01,-0.17709E+01,-0.17764E+01,-0.17819E+01, + &-0.17874E+01,-0.17929E+01,-0.17984E+01,-0.18039E+01,-0.18093E+01, + &-0.18148E+01,-0.18203E+01,-0.18257E+01,-0.18312E+01,-0.18366E+01, + &-0.18420E+01,-0.18475E+01,-0.18529E+01,-0.18583E+01,-0.18637E+01, + &-0.18691E+01,-0.18745E+01,-0.18799E+01,-0.18853E+01,-0.18907E+01, + &-0.18960E+01 + & / +C +C *** (NH4)2SO4 +C + DATA (BNC04M (I),I= 1,100)/ + &-0.11131E+00,-0.20410E+00,-0.27045E+00,-0.31626E+00,-0.35200E+00, + &-0.38161E+00,-0.40704E+00,-0.42941E+00,-0.44944E+00,-0.46762E+00, + &-0.48429E+00,-0.49971E+00,-0.51407E+00,-0.52753E+00,-0.54020E+00, + &-0.55219E+00,-0.56357E+00,-0.57441E+00,-0.58476E+00,-0.59468E+00, + &-0.60421E+00,-0.61337E+00,-0.62220E+00,-0.63073E+00,-0.63898E+00, + &-0.64698E+00,-0.65473E+00,-0.66226E+00,-0.66958E+00,-0.67670E+00, + &-0.68364E+00,-0.69041E+00,-0.69701E+00,-0.70347E+00,-0.70977E+00, + &-0.71594E+00,-0.72198E+00,-0.72789E+00,-0.73369E+00,-0.73937E+00, + &-0.74495E+00,-0.75042E+00,-0.75579E+00,-0.76107E+00,-0.76627E+00, + &-0.77137E+00,-0.77639E+00,-0.78133E+00,-0.78620E+00,-0.79099E+00, + &-0.79571E+00,-0.80036E+00,-0.80495E+00,-0.80947E+00,-0.81393E+00, + &-0.81834E+00,-0.82268E+00,-0.82697E+00,-0.83121E+00,-0.83540E+00, + &-0.83954E+00,-0.84363E+00,-0.84768E+00,-0.85168E+00,-0.85563E+00, + &-0.85955E+00,-0.86343E+00,-0.86727E+00,-0.87107E+00,-0.87483E+00, + &-0.87856E+00,-0.88226E+00,-0.88592E+00,-0.88956E+00,-0.89316E+00, + &-0.89673E+00,-0.90027E+00,-0.90379E+00,-0.90728E+00,-0.91075E+00, + &-0.91419E+00,-0.91760E+00,-0.92099E+00,-0.92436E+00,-0.92771E+00, + &-0.93104E+00,-0.93434E+00,-0.93763E+00,-0.94089E+00,-0.94414E+00, + &-0.94737E+00,-0.95058E+00,-0.95377E+00,-0.95694E+00,-0.96010E+00, + &-0.96324E+00,-0.96636E+00,-0.96947E+00,-0.97256E+00,-0.97564E+00/ + + DATA (BNC04M (I),I=101,200)/ + &-0.97870E+00,-0.98175E+00,-0.98478E+00,-0.98780E+00,-0.99081E+00, + &-0.99380E+00,-0.99677E+00,-0.99974E+00,-0.10027E+01,-0.10056E+01, + &-0.10085E+01,-0.10115E+01,-0.10144E+01,-0.10172E+01,-0.10201E+01, + &-0.10230E+01,-0.10258E+01,-0.10286E+01,-0.10315E+01,-0.10343E+01, + &-0.10370E+01,-0.10398E+01,-0.10426E+01,-0.10454E+01,-0.10481E+01, + &-0.10509E+01,-0.10536E+01,-0.10563E+01,-0.10590E+01,-0.10617E+01, + &-0.10644E+01,-0.10671E+01,-0.10698E+01,-0.10724E+01,-0.10751E+01, + &-0.10777E+01,-0.10803E+01,-0.10830E+01,-0.10856E+01,-0.10882E+01, + &-0.10908E+01,-0.10933E+01,-0.10959E+01,-0.10985E+01,-0.11010E+01, + &-0.11036E+01,-0.11061E+01,-0.11086E+01,-0.11111E+01,-0.11136E+01, + &-0.11161E+01,-0.11186E+01,-0.11211E+01,-0.11236E+01,-0.11260E+01, + &-0.11285E+01,-0.11309E+01,-0.11334E+01,-0.11358E+01,-0.11382E+01, + &-0.11406E+01,-0.11431E+01,-0.11455E+01,-0.11479E+01,-0.11502E+01, + &-0.11526E+01,-0.11550E+01,-0.11574E+01,-0.11597E+01,-0.11621E+01, + &-0.11644E+01,-0.11668E+01,-0.11691E+01,-0.11714E+01,-0.11737E+01, + &-0.11761E+01,-0.11784E+01,-0.11807E+01,-0.11830E+01,-0.11852E+01, + &-0.11875E+01,-0.11898E+01,-0.11921E+01,-0.11943E+01,-0.11966E+01, + &-0.11988E+01,-0.12011E+01,-0.12033E+01,-0.12056E+01,-0.12078E+01, + &-0.12100E+01,-0.12122E+01,-0.12144E+01,-0.12166E+01,-0.12189E+01, + &-0.12210E+01,-0.12232E+01,-0.12254E+01,-0.12276E+01,-0.12298E+01/ + + DATA (BNC04M (I),I=201,300)/ + &-0.12319E+01,-0.12341E+01,-0.12363E+01,-0.12384E+01,-0.12406E+01, + &-0.12427E+01,-0.12449E+01,-0.12470E+01,-0.12491E+01,-0.12513E+01, + &-0.12534E+01,-0.12555E+01,-0.12576E+01,-0.12597E+01,-0.12618E+01, + &-0.12639E+01,-0.12660E+01,-0.12681E+01,-0.12702E+01,-0.12723E+01, + &-0.12743E+01,-0.12764E+01,-0.12785E+01,-0.12805E+01,-0.12826E+01, + &-0.12847E+01,-0.12867E+01,-0.12888E+01,-0.12908E+01,-0.12928E+01, + &-0.12949E+01,-0.12969E+01,-0.12989E+01,-0.13010E+01,-0.13030E+01, + &-0.13050E+01,-0.13070E+01,-0.13090E+01,-0.13110E+01,-0.13130E+01, + &-0.13150E+01,-0.13170E+01,-0.13190E+01,-0.13210E+01,-0.13230E+01, + &-0.13249E+01,-0.13269E+01,-0.13289E+01,-0.13309E+01,-0.13328E+01, + &-0.13348E+01,-0.13367E+01,-0.13387E+01,-0.13406E+01,-0.13426E+01, + &-0.13445E+01,-0.13465E+01,-0.13484E+01,-0.13504E+01,-0.13523E+01, + &-0.13542E+01,-0.13561E+01,-0.13581E+01,-0.13600E+01,-0.13619E+01, + &-0.13638E+01,-0.13657E+01,-0.13676E+01,-0.13695E+01,-0.13714E+01, + &-0.13733E+01,-0.13752E+01,-0.13771E+01,-0.13790E+01,-0.13809E+01, + &-0.13828E+01,-0.13846E+01,-0.13865E+01,-0.13884E+01,-0.13903E+01, + &-0.13921E+01,-0.13940E+01,-0.13958E+01,-0.13977E+01,-0.13996E+01, + &-0.14014E+01,-0.14033E+01,-0.14051E+01,-0.14070E+01,-0.14088E+01, + &-0.14106E+01,-0.14125E+01,-0.14143E+01,-0.14162E+01,-0.14180E+01, + &-0.14198E+01,-0.14216E+01,-0.14235E+01,-0.14253E+01,-0.14271E+01/ + + DATA (BNC04M (I),I=301,400)/ + &-0.14289E+01,-0.14307E+01,-0.14325E+01,-0.14343E+01,-0.14361E+01, + &-0.14379E+01,-0.14397E+01,-0.14415E+01,-0.14433E+01,-0.14451E+01, + &-0.14469E+01,-0.14487E+01,-0.14505E+01,-0.14523E+01,-0.14541E+01, + &-0.14558E+01,-0.14576E+01,-0.14594E+01,-0.14612E+01,-0.14629E+01, + &-0.14647E+01,-0.14665E+01,-0.14682E+01,-0.14700E+01,-0.14717E+01, + &-0.14735E+01,-0.14752E+01,-0.14770E+01,-0.14787E+01,-0.14805E+01, + &-0.14822E+01,-0.14840E+01,-0.14857E+01,-0.14875E+01,-0.14892E+01, + &-0.14909E+01,-0.14927E+01,-0.14944E+01,-0.14961E+01,-0.14979E+01, + &-0.14996E+01,-0.15013E+01,-0.15030E+01,-0.15047E+01,-0.15065E+01, + &-0.15082E+01,-0.15099E+01,-0.15116E+01,-0.15133E+01,-0.15150E+01, + &-0.15167E+01,-0.15184E+01,-0.15201E+01,-0.15218E+01,-0.15235E+01, + &-0.15252E+01,-0.15269E+01,-0.15286E+01,-0.15303E+01,-0.15320E+01, + &-0.15337E+01,-0.15353E+01,-0.15370E+01,-0.15387E+01,-0.15404E+01, + &-0.15421E+01,-0.15437E+01,-0.15454E+01,-0.15471E+01,-0.15488E+01, + &-0.15504E+01,-0.15521E+01,-0.15538E+01,-0.15554E+01,-0.15571E+01, + &-0.15587E+01,-0.15604E+01,-0.15620E+01,-0.15637E+01,-0.15654E+01, + &-0.15670E+01,-0.15687E+01,-0.15703E+01,-0.15720E+01,-0.15736E+01, + &-0.15752E+01,-0.15769E+01,-0.15785E+01,-0.15802E+01,-0.15818E+01, + &-0.15834E+01,-0.15851E+01,-0.15867E+01,-0.15883E+01,-0.15900E+01, + &-0.15916E+01,-0.15932E+01,-0.15948E+01,-0.15965E+01,-0.15981E+01/ + + DATA (BNC04M (I),I=401,500)/ + &-0.15997E+01,-0.16013E+01,-0.16029E+01,-0.16045E+01,-0.16062E+01, + &-0.16078E+01,-0.16094E+01,-0.16110E+01,-0.16126E+01,-0.16142E+01, + &-0.16158E+01,-0.16174E+01,-0.16190E+01,-0.16206E+01,-0.16222E+01, + &-0.16238E+01,-0.16254E+01,-0.16270E+01,-0.16286E+01,-0.16302E+01, + &-0.16318E+01,-0.16334E+01,-0.16349E+01,-0.16365E+01,-0.16381E+01, + &-0.16397E+01,-0.16413E+01,-0.16429E+01,-0.16444E+01,-0.16460E+01, + &-0.16476E+01,-0.16492E+01,-0.16507E+01,-0.16523E+01,-0.16539E+01, + &-0.16555E+01,-0.16570E+01,-0.16586E+01,-0.16602E+01,-0.16617E+01, + &-0.16633E+01,-0.16648E+01,-0.16664E+01,-0.16680E+01,-0.16695E+01, + &-0.16711E+01,-0.16726E+01,-0.16742E+01,-0.16757E+01,-0.16773E+01, + &-0.16788E+01,-0.16804E+01,-0.16819E+01,-0.16835E+01,-0.16850E+01, + &-0.16866E+01,-0.16881E+01,-0.16897E+01,-0.16912E+01,-0.16928E+01, + &-0.16943E+01,-0.16958E+01,-0.16974E+01,-0.16989E+01,-0.17004E+01, + &-0.17020E+01,-0.17035E+01,-0.17050E+01,-0.17066E+01,-0.17081E+01, + &-0.17096E+01,-0.17111E+01,-0.17127E+01,-0.17142E+01,-0.17157E+01, + &-0.17172E+01,-0.17187E+01,-0.17203E+01,-0.17218E+01,-0.17233E+01, + &-0.17248E+01,-0.17263E+01,-0.17278E+01,-0.17294E+01,-0.17309E+01, + &-0.17324E+01,-0.17339E+01,-0.17354E+01,-0.17369E+01,-0.17384E+01, + &-0.17399E+01,-0.17414E+01,-0.17429E+01,-0.17444E+01,-0.17459E+01, + &-0.17474E+01,-0.17489E+01,-0.17504E+01,-0.17519E+01,-0.17534E+01/ + + DATA (BNC04M (I),I=501,600)/ + &-0.17549E+01,-0.17564E+01,-0.17579E+01,-0.17594E+01,-0.17609E+01, + &-0.17623E+01,-0.17638E+01,-0.17653E+01,-0.17668E+01,-0.17683E+01, + &-0.17698E+01,-0.17713E+01,-0.17727E+01,-0.17742E+01,-0.17757E+01, + &-0.17772E+01,-0.17787E+01,-0.17801E+01,-0.17816E+01,-0.17831E+01, + &-0.17846E+01,-0.17860E+01,-0.17875E+01,-0.17890E+01,-0.17904E+01, + &-0.17919E+01,-0.17934E+01,-0.17948E+01,-0.17963E+01,-0.17978E+01, + &-0.17992E+01,-0.18007E+01,-0.18022E+01,-0.18036E+01,-0.18051E+01, + &-0.18065E+01,-0.18080E+01,-0.18095E+01,-0.18109E+01,-0.18124E+01, + &-0.18138E+01,-0.18153E+01,-0.18167E+01,-0.18182E+01,-0.18196E+01, + &-0.18211E+01,-0.18225E+01,-0.18240E+01,-0.18254E+01,-0.18269E+01, + &-0.18283E+01,-0.18298E+01,-0.18312E+01,-0.18327E+01,-0.18341E+01, + &-0.18356E+01,-0.18370E+01,-0.18384E+01,-0.18399E+01,-0.18413E+01, + &-0.18427E+01,-0.18442E+01,-0.18456E+01,-0.18471E+01,-0.18485E+01, + &-0.18499E+01,-0.18514E+01,-0.18528E+01,-0.18542E+01,-0.18556E+01, + &-0.18571E+01,-0.18585E+01,-0.18599E+01,-0.18614E+01,-0.18628E+01, + &-0.18642E+01,-0.18656E+01,-0.18671E+01,-0.18685E+01,-0.18699E+01, + &-0.18713E+01,-0.18727E+01,-0.18742E+01,-0.18756E+01,-0.18770E+01, + &-0.18784E+01,-0.18798E+01,-0.18812E+01,-0.18827E+01,-0.18841E+01, + &-0.18855E+01,-0.18869E+01,-0.18883E+01,-0.18897E+01,-0.18911E+01, + &-0.18925E+01,-0.18940E+01,-0.18954E+01,-0.18968E+01,-0.19020E+01/ + + DATA (BNC04M (I),I=601,700)/ + &-0.19136E+01,-0.19275E+01,-0.19414E+01,-0.19552E+01,-0.19689E+01, + &-0.19826E+01,-0.19962E+01,-0.20097E+01,-0.20232E+01,-0.20366E+01, + &-0.20500E+01,-0.20633E+01,-0.20766E+01,-0.20897E+01,-0.21029E+01, + &-0.21160E+01,-0.21290E+01,-0.21420E+01,-0.21550E+01,-0.21679E+01, + &-0.21807E+01,-0.21935E+01,-0.22063E+01,-0.22190E+01,-0.22317E+01, + &-0.22443E+01,-0.22569E+01,-0.22695E+01,-0.22820E+01,-0.22945E+01, + &-0.23069E+01,-0.23193E+01,-0.23317E+01,-0.23440E+01,-0.23563E+01, + &-0.23686E+01,-0.23808E+01,-0.23930E+01,-0.24052E+01,-0.24173E+01, + &-0.24294E+01,-0.24415E+01,-0.24535E+01,-0.24655E+01,-0.24775E+01, + &-0.24895E+01,-0.25014E+01,-0.25133E+01,-0.25252E+01,-0.25370E+01, + &-0.25488E+01,-0.25606E+01,-0.25724E+01,-0.25841E+01,-0.25959E+01, + &-0.26076E+01,-0.26192E+01,-0.26309E+01,-0.26425E+01,-0.26541E+01, + &-0.26657E+01,-0.26772E+01,-0.26887E+01,-0.27002E+01,-0.27117E+01, + &-0.27232E+01,-0.27346E+01,-0.27461E+01,-0.27575E+01,-0.27688E+01, + &-0.27802E+01,-0.27915E+01,-0.28029E+01,-0.28142E+01,-0.28255E+01, + &-0.28367E+01,-0.28480E+01,-0.28592E+01,-0.28704E+01,-0.28816E+01, + &-0.28928E+01,-0.29039E+01,-0.29151E+01,-0.29262E+01,-0.29373E+01, + &-0.29484E+01,-0.29595E+01,-0.29705E+01,-0.29816E+01,-0.29926E+01, + &-0.30036E+01,-0.30146E+01,-0.30256E+01,-0.30366E+01,-0.30475E+01, + &-0.30585E+01,-0.30694E+01,-0.30803E+01,-0.30912E+01,-0.31021E+01/ + + DATA (BNC04M(I),I=701,741)/ + &-0.31129E+01,-0.31238E+01,-0.31346E+01,-0.31454E+01,-0.31562E+01, + &-0.31670E+01,-0.31778E+01,-0.31886E+01,-0.31993E+01,-0.32101E+01, + &-0.32208E+01,-0.32315E+01,-0.32423E+01,-0.32529E+01,-0.32636E+01, + &-0.32743E+01,-0.32850E+01,-0.32956E+01,-0.33062E+01,-0.33169E+01, + &-0.33275E+01,-0.33381E+01,-0.33487E+01,-0.33592E+01,-0.33698E+01, + &-0.33804E+01,-0.33909E+01,-0.34015E+01,-0.34120E+01,-0.34225E+01, + &-0.34330E+01,-0.34435E+01,-0.34540E+01,-0.34644E+01,-0.34749E+01, + &-0.34854E+01,-0.34958E+01,-0.35062E+01,-0.35166E+01,-0.35271E+01, + &-0.35375E+01 + & / +C +C *** NH4NO3 +C + DATA (BNC05M (I),I= 1,100)/ + &-0.56573E-01,-0.10548E+00,-0.14176E+00,-0.16761E+00,-0.18833E+00, + &-0.20590E+00,-0.22130E+00,-0.23513E+00,-0.24773E+00,-0.25937E+00, + &-0.27021E+00,-0.28039E+00,-0.29000E+00,-0.29914E+00,-0.30784E+00, + &-0.31618E+00,-0.32419E+00,-0.33189E+00,-0.33933E+00,-0.34653E+00, + &-0.35350E+00,-0.36027E+00,-0.36685E+00,-0.37326E+00,-0.37950E+00, + &-0.38559E+00,-0.39153E+00,-0.39735E+00,-0.40303E+00,-0.40860E+00, + &-0.41405E+00,-0.41939E+00,-0.42463E+00,-0.42977E+00,-0.43481E+00, + &-0.43977E+00,-0.44464E+00,-0.44943E+00,-0.45413E+00,-0.45876E+00, + &-0.46332E+00,-0.46780E+00,-0.47221E+00,-0.47656E+00,-0.48084E+00, + &-0.48506E+00,-0.48922E+00,-0.49332E+00,-0.49737E+00,-0.50136E+00, + &-0.50529E+00,-0.50918E+00,-0.51301E+00,-0.51680E+00,-0.52054E+00, + &-0.52424E+00,-0.52790E+00,-0.53151E+00,-0.53508E+00,-0.53861E+00, + &-0.54211E+00,-0.54557E+00,-0.54899E+00,-0.55239E+00,-0.55575E+00, + &-0.55908E+00,-0.56238E+00,-0.56565E+00,-0.56890E+00,-0.57212E+00, + &-0.57531E+00,-0.57848E+00,-0.58163E+00,-0.58476E+00,-0.58787E+00, + &-0.59096E+00,-0.59403E+00,-0.59708E+00,-0.60011E+00,-0.60313E+00, + &-0.60614E+00,-0.60912E+00,-0.61210E+00,-0.61506E+00,-0.61801E+00, + &-0.62095E+00,-0.62387E+00,-0.62678E+00,-0.62969E+00,-0.63258E+00, + &-0.63546E+00,-0.63833E+00,-0.64120E+00,-0.64405E+00,-0.64689E+00, + &-0.64973E+00,-0.65255E+00,-0.65537E+00,-0.65818E+00,-0.66098E+00/ + + DATA (BNC05M (I),I=101,200)/ + &-0.66377E+00,-0.66655E+00,-0.66933E+00,-0.67209E+00,-0.67485E+00, + &-0.67760E+00,-0.68034E+00,-0.68307E+00,-0.68579E+00,-0.68850E+00, + &-0.69121E+00,-0.69390E+00,-0.69659E+00,-0.69927E+00,-0.70194E+00, + &-0.70459E+00,-0.70724E+00,-0.70988E+00,-0.71251E+00,-0.71514E+00, + &-0.71759E+00,-0.72021E+00,-0.72282E+00,-0.72542E+00,-0.72800E+00, + &-0.73058E+00,-0.73314E+00,-0.73570E+00,-0.73824E+00,-0.74077E+00, + &-0.74329E+00,-0.74580E+00,-0.74830E+00,-0.75079E+00,-0.75327E+00, + &-0.75574E+00,-0.75821E+00,-0.76066E+00,-0.76310E+00,-0.76553E+00, + &-0.76795E+00,-0.77036E+00,-0.77277E+00,-0.77516E+00,-0.77755E+00, + &-0.77992E+00,-0.78229E+00,-0.78465E+00,-0.78700E+00,-0.78934E+00, + &-0.79167E+00,-0.79400E+00,-0.79631E+00,-0.79862E+00,-0.80092E+00, + &-0.80321E+00,-0.80549E+00,-0.80776E+00,-0.81003E+00,-0.81229E+00, + &-0.81454E+00,-0.81678E+00,-0.81901E+00,-0.82124E+00,-0.82346E+00, + &-0.82567E+00,-0.82787E+00,-0.83007E+00,-0.83226E+00,-0.83444E+00, + &-0.83661E+00,-0.83878E+00,-0.84094E+00,-0.84309E+00,-0.84524E+00, + &-0.84738E+00,-0.84951E+00,-0.85163E+00,-0.85375E+00,-0.85586E+00, + &-0.85797E+00,-0.86006E+00,-0.86215E+00,-0.86424E+00,-0.86632E+00, + &-0.86839E+00,-0.87045E+00,-0.87251E+00,-0.87456E+00,-0.87661E+00, + &-0.87865E+00,-0.88068E+00,-0.88271E+00,-0.88473E+00,-0.88675E+00, + &-0.88876E+00,-0.89076E+00,-0.89276E+00,-0.89475E+00,-0.89673E+00/ + + DATA (BNC05M (I),I=201,300)/ + &-0.89871E+00,-0.90068E+00,-0.90265E+00,-0.90462E+00,-0.90657E+00, + &-0.90852E+00,-0.91047E+00,-0.91241E+00,-0.91434E+00,-0.91627E+00, + &-0.91819E+00,-0.92011E+00,-0.92202E+00,-0.92393E+00,-0.92583E+00, + &-0.92773E+00,-0.92962E+00,-0.93151E+00,-0.93339E+00,-0.93526E+00, + &-0.93713E+00,-0.93900E+00,-0.94086E+00,-0.94272E+00,-0.94457E+00, + &-0.94641E+00,-0.94825E+00,-0.95009E+00,-0.95192E+00,-0.95375E+00, + &-0.95557E+00,-0.95738E+00,-0.95920E+00,-0.96100E+00,-0.96281E+00, + &-0.96460E+00,-0.96640E+00,-0.96818E+00,-0.96997E+00,-0.97175E+00, + &-0.97352E+00,-0.97529E+00,-0.97706E+00,-0.97882E+00,-0.98058E+00, + &-0.98233E+00,-0.98408E+00,-0.98582E+00,-0.98756E+00,-0.98930E+00, + &-0.99103E+00,-0.99276E+00,-0.99448E+00,-0.99620E+00,-0.99791E+00, + &-0.99962E+00,-0.10013E+01,-0.10030E+01,-0.10047E+01,-0.10064E+01, + &-0.10081E+01,-0.10098E+01,-0.10115E+01,-0.10132E+01,-0.10148E+01, + &-0.10165E+01,-0.10182E+01,-0.10198E+01,-0.10215E+01,-0.10231E+01, + &-0.10248E+01,-0.10264E+01,-0.10281E+01,-0.10297E+01,-0.10314E+01, + &-0.10330E+01,-0.10346E+01,-0.10363E+01,-0.10379E+01,-0.10395E+01, + &-0.10411E+01,-0.10427E+01,-0.10443E+01,-0.10459E+01,-0.10475E+01, + &-0.10491E+01,-0.10507E+01,-0.10523E+01,-0.10539E+01,-0.10555E+01, + &-0.10571E+01,-0.10586E+01,-0.10602E+01,-0.10618E+01,-0.10633E+01, + &-0.10649E+01,-0.10665E+01,-0.10680E+01,-0.10696E+01,-0.10711E+01/ + + DATA (BNC05M (I),I=301,400)/ + &-0.10727E+01,-0.10742E+01,-0.10757E+01,-0.10773E+01,-0.10788E+01, + &-0.10803E+01,-0.10819E+01,-0.10834E+01,-0.10849E+01,-0.10864E+01, + &-0.10879E+01,-0.10895E+01,-0.10910E+01,-0.10925E+01,-0.10940E+01, + &-0.10955E+01,-0.10970E+01,-0.10985E+01,-0.10999E+01,-0.11014E+01, + &-0.11029E+01,-0.11044E+01,-0.11059E+01,-0.11073E+01,-0.11088E+01, + &-0.11103E+01,-0.11118E+01,-0.11132E+01,-0.11147E+01,-0.11161E+01, + &-0.11176E+01,-0.11190E+01,-0.11205E+01,-0.11219E+01,-0.11234E+01, + &-0.11248E+01,-0.11263E+01,-0.11277E+01,-0.11291E+01,-0.11306E+01, + &-0.11320E+01,-0.11334E+01,-0.11348E+01,-0.11363E+01,-0.11377E+01, + &-0.11391E+01,-0.11405E+01,-0.11419E+01,-0.11433E+01,-0.11447E+01, + &-0.11461E+01,-0.11475E+01,-0.11489E+01,-0.11503E+01,-0.11517E+01, + &-0.11531E+01,-0.11545E+01,-0.11559E+01,-0.11572E+01,-0.11586E+01, + &-0.11600E+01,-0.11614E+01,-0.11627E+01,-0.11641E+01,-0.11655E+01, + &-0.11668E+01,-0.11682E+01,-0.11696E+01,-0.11709E+01,-0.11723E+01, + &-0.11736E+01,-0.11750E+01,-0.11763E+01,-0.11777E+01,-0.11790E+01, + &-0.11804E+01,-0.11817E+01,-0.11830E+01,-0.11844E+01,-0.11857E+01, + &-0.11870E+01,-0.11884E+01,-0.11897E+01,-0.11910E+01,-0.11923E+01, + &-0.11936E+01,-0.11950E+01,-0.11963E+01,-0.11976E+01,-0.11989E+01, + &-0.12002E+01,-0.12015E+01,-0.12028E+01,-0.12041E+01,-0.12054E+01, + &-0.12067E+01,-0.12080E+01,-0.12093E+01,-0.12106E+01,-0.12119E+01/ + + DATA (BNC05M (I),I=401,500)/ + &-0.12132E+01,-0.12144E+01,-0.12157E+01,-0.12170E+01,-0.12183E+01, + &-0.12196E+01,-0.12208E+01,-0.12221E+01,-0.12234E+01,-0.12246E+01, + &-0.12259E+01,-0.12272E+01,-0.12284E+01,-0.12297E+01,-0.12310E+01, + &-0.12322E+01,-0.12335E+01,-0.12347E+01,-0.12360E+01,-0.12372E+01, + &-0.12385E+01,-0.12397E+01,-0.12409E+01,-0.12422E+01,-0.12434E+01, + &-0.12447E+01,-0.12459E+01,-0.12471E+01,-0.12484E+01,-0.12496E+01, + &-0.12508E+01,-0.12520E+01,-0.12533E+01,-0.12545E+01,-0.12557E+01, + &-0.12569E+01,-0.12581E+01,-0.12594E+01,-0.12606E+01,-0.12618E+01, + &-0.12630E+01,-0.12642E+01,-0.12654E+01,-0.12666E+01,-0.12678E+01, + &-0.12690E+01,-0.12702E+01,-0.12714E+01,-0.12726E+01,-0.12738E+01, + &-0.12750E+01,-0.12762E+01,-0.12774E+01,-0.12786E+01,-0.12797E+01, + &-0.12809E+01,-0.12821E+01,-0.12833E+01,-0.12845E+01,-0.12856E+01, + &-0.12868E+01,-0.12880E+01,-0.12892E+01,-0.12903E+01,-0.12915E+01, + &-0.12927E+01,-0.12938E+01,-0.12950E+01,-0.12962E+01,-0.12973E+01, + &-0.12985E+01,-0.12996E+01,-0.13008E+01,-0.13020E+01,-0.13031E+01, + &-0.13043E+01,-0.13054E+01,-0.13066E+01,-0.13077E+01,-0.13088E+01, + &-0.13100E+01,-0.13111E+01,-0.13123E+01,-0.13134E+01,-0.13146E+01, + &-0.13157E+01,-0.13168E+01,-0.13180E+01,-0.13191E+01,-0.13202E+01, + &-0.13213E+01,-0.13225E+01,-0.13236E+01,-0.13247E+01,-0.13258E+01, + &-0.13270E+01,-0.13281E+01,-0.13292E+01,-0.13303E+01,-0.13314E+01/ + + DATA (BNC05M (I),I=501,600)/ + &-0.13325E+01,-0.13337E+01,-0.13348E+01,-0.13359E+01,-0.13370E+01, + &-0.13381E+01,-0.13392E+01,-0.13403E+01,-0.13414E+01,-0.13425E+01, + &-0.13436E+01,-0.13447E+01,-0.13458E+01,-0.13469E+01,-0.13480E+01, + &-0.13491E+01,-0.13502E+01,-0.13513E+01,-0.13524E+01,-0.13534E+01, + &-0.13545E+01,-0.13556E+01,-0.13567E+01,-0.13578E+01,-0.13589E+01, + &-0.13599E+01,-0.13610E+01,-0.13621E+01,-0.13632E+01,-0.13643E+01, + &-0.13653E+01,-0.13664E+01,-0.13675E+01,-0.13685E+01,-0.13696E+01, + &-0.13707E+01,-0.13717E+01,-0.13728E+01,-0.13739E+01,-0.13749E+01, + &-0.13760E+01,-0.13770E+01,-0.13781E+01,-0.13792E+01,-0.13802E+01, + &-0.13813E+01,-0.13823E+01,-0.13834E+01,-0.13844E+01,-0.13855E+01, + &-0.13865E+01,-0.13876E+01,-0.13886E+01,-0.13897E+01,-0.13907E+01, + &-0.13917E+01,-0.13928E+01,-0.13938E+01,-0.13949E+01,-0.13959E+01, + &-0.13969E+01,-0.13980E+01,-0.13990E+01,-0.14000E+01,-0.14011E+01, + &-0.14021E+01,-0.14031E+01,-0.14042E+01,-0.14052E+01,-0.14062E+01, + &-0.14072E+01,-0.14083E+01,-0.14093E+01,-0.14103E+01,-0.14113E+01, + &-0.14123E+01,-0.14134E+01,-0.14144E+01,-0.14154E+01,-0.14164E+01, + &-0.14174E+01,-0.14184E+01,-0.14194E+01,-0.14205E+01,-0.14215E+01, + &-0.14225E+01,-0.14235E+01,-0.14245E+01,-0.14255E+01,-0.14265E+01, + &-0.14275E+01,-0.14285E+01,-0.14295E+01,-0.14305E+01,-0.14315E+01, + &-0.14325E+01,-0.14335E+01,-0.14345E+01,-0.14355E+01,-0.14392E+01/ + + DATA (BNC05M (I),I=601,700)/ + &-0.14473E+01,-0.14571E+01,-0.14668E+01,-0.14763E+01,-0.14858E+01, + &-0.14952E+01,-0.15045E+01,-0.15137E+01,-0.15229E+01,-0.15319E+01, + &-0.15409E+01,-0.15498E+01,-0.15586E+01,-0.15674E+01,-0.15761E+01, + &-0.15847E+01,-0.15933E+01,-0.16017E+01,-0.16102E+01,-0.16185E+01, + &-0.16268E+01,-0.16351E+01,-0.16433E+01,-0.16514E+01,-0.16595E+01, + &-0.16675E+01,-0.16754E+01,-0.16834E+01,-0.16912E+01,-0.16990E+01, + &-0.17068E+01,-0.17145E+01,-0.17222E+01,-0.17298E+01,-0.17374E+01, + &-0.17450E+01,-0.17525E+01,-0.17599E+01,-0.17674E+01,-0.17747E+01, + &-0.17821E+01,-0.17894E+01,-0.17967E+01,-0.18039E+01,-0.18111E+01, + &-0.18182E+01,-0.18254E+01,-0.18325E+01,-0.18395E+01,-0.18466E+01, + &-0.18535E+01,-0.18605E+01,-0.18674E+01,-0.18743E+01,-0.18812E+01, + &-0.18881E+01,-0.18949E+01,-0.19017E+01,-0.19084E+01,-0.19152E+01, + &-0.19219E+01,-0.19285E+01,-0.19352E+01,-0.19418E+01,-0.19484E+01, + &-0.19550E+01,-0.19616E+01,-0.19681E+01,-0.19746E+01,-0.19811E+01, + &-0.19876E+01,-0.19940E+01,-0.20004E+01,-0.20068E+01,-0.20132E+01, + &-0.20196E+01,-0.20259E+01,-0.20322E+01,-0.20385E+01,-0.20448E+01, + &-0.20510E+01,-0.20573E+01,-0.20635E+01,-0.20697E+01,-0.20759E+01, + &-0.20821E+01,-0.20882E+01,-0.20943E+01,-0.21005E+01,-0.21066E+01, + &-0.21126E+01,-0.21187E+01,-0.21247E+01,-0.21308E+01,-0.21368E+01, + &-0.21428E+01,-0.21488E+01,-0.21548E+01,-0.21607E+01,-0.21667E+01/ + + DATA (BNC05M(I),I=701,741)/ + &-0.21726E+01,-0.21785E+01,-0.21844E+01,-0.21903E+01,-0.21962E+01, + &-0.22020E+01,-0.22079E+01,-0.22137E+01,-0.22195E+01,-0.22253E+01, + &-0.22311E+01,-0.22369E+01,-0.22427E+01,-0.22484E+01,-0.22542E+01, + &-0.22599E+01,-0.22656E+01,-0.22714E+01,-0.22771E+01,-0.22827E+01, + &-0.22884E+01,-0.22941E+01,-0.22997E+01,-0.23054E+01,-0.23110E+01, + &-0.23167E+01,-0.23223E+01,-0.23279E+01,-0.23335E+01,-0.23390E+01, + &-0.23446E+01,-0.23502E+01,-0.23557E+01,-0.23613E+01,-0.23668E+01, + &-0.23723E+01,-0.23779E+01,-0.23834E+01,-0.23889E+01,-0.23944E+01, + &-0.23998E+01 + & / +C +C *** NH4Cl +C + DATA (BNC06M (I),I= 1,100)/ + &-0.54668E-01,-0.98406E-01,-0.12832E+00,-0.14814E+00,-0.16306E+00, + &-0.17499E+00,-0.18490E+00,-0.19335E+00,-0.20067E+00,-0.20712E+00, + &-0.21285E+00,-0.21799E+00,-0.22263E+00,-0.22685E+00,-0.23071E+00, + &-0.23426E+00,-0.23752E+00,-0.24054E+00,-0.24335E+00,-0.24596E+00, + &-0.24839E+00,-0.25066E+00,-0.25280E+00,-0.25480E+00,-0.25668E+00, + &-0.25846E+00,-0.26014E+00,-0.26172E+00,-0.26322E+00,-0.26464E+00, + &-0.26599E+00,-0.26728E+00,-0.26850E+00,-0.26967E+00,-0.27078E+00, + &-0.27184E+00,-0.27286E+00,-0.27383E+00,-0.27477E+00,-0.27566E+00, + &-0.27653E+00,-0.27736E+00,-0.27815E+00,-0.27892E+00,-0.27966E+00, + &-0.28038E+00,-0.28107E+00,-0.28174E+00,-0.28239E+00,-0.28302E+00, + &-0.28363E+00,-0.28422E+00,-0.28479E+00,-0.28535E+00,-0.28588E+00, + &-0.28641E+00,-0.28692E+00,-0.28741E+00,-0.28789E+00,-0.28836E+00, + &-0.28882E+00,-0.28926E+00,-0.28969E+00,-0.29010E+00,-0.29051E+00, + &-0.29090E+00,-0.29128E+00,-0.29165E+00,-0.29201E+00,-0.29235E+00, + &-0.29269E+00,-0.29301E+00,-0.29332E+00,-0.29362E+00,-0.29390E+00, + &-0.29418E+00,-0.29444E+00,-0.29470E+00,-0.29494E+00,-0.29517E+00, + &-0.29538E+00,-0.29559E+00,-0.29578E+00,-0.29597E+00,-0.29614E+00, + &-0.29630E+00,-0.29645E+00,-0.29659E+00,-0.29671E+00,-0.29683E+00, + &-0.29694E+00,-0.29703E+00,-0.29711E+00,-0.29719E+00,-0.29725E+00, + &-0.29731E+00,-0.29735E+00,-0.29739E+00,-0.29741E+00,-0.29743E+00/ + + DATA (BNC06M (I),I=101,200)/ + &-0.29744E+00,-0.29744E+00,-0.29743E+00,-0.29741E+00,-0.29739E+00, + &-0.29736E+00,-0.29732E+00,-0.29727E+00,-0.29722E+00,-0.29716E+00, + &-0.29710E+00,-0.29703E+00,-0.29695E+00,-0.29687E+00,-0.29678E+00, + &-0.29669E+00,-0.29660E+00,-0.29650E+00,-0.29639E+00,-0.29628E+00, + &-0.29628E+00,-0.29615E+00,-0.29602E+00,-0.29589E+00,-0.29576E+00, + &-0.29562E+00,-0.29548E+00,-0.29534E+00,-0.29520E+00,-0.29506E+00, + &-0.29491E+00,-0.29477E+00,-0.29462E+00,-0.29447E+00,-0.29432E+00, + &-0.29417E+00,-0.29402E+00,-0.29386E+00,-0.29371E+00,-0.29355E+00, + &-0.29339E+00,-0.29323E+00,-0.29308E+00,-0.29291E+00,-0.29275E+00, + &-0.29259E+00,-0.29243E+00,-0.29226E+00,-0.29210E+00,-0.29193E+00, + &-0.29177E+00,-0.29160E+00,-0.29143E+00,-0.29127E+00,-0.29110E+00, + &-0.29093E+00,-0.29076E+00,-0.29059E+00,-0.29042E+00,-0.29025E+00, + &-0.29008E+00,-0.28990E+00,-0.28973E+00,-0.28956E+00,-0.28939E+00, + &-0.28921E+00,-0.28904E+00,-0.28887E+00,-0.28869E+00,-0.28852E+00, + &-0.28835E+00,-0.28817E+00,-0.28800E+00,-0.28782E+00,-0.28765E+00, + &-0.28747E+00,-0.28730E+00,-0.28712E+00,-0.28695E+00,-0.28677E+00, + &-0.28660E+00,-0.28642E+00,-0.28625E+00,-0.28607E+00,-0.28590E+00, + &-0.28572E+00,-0.28555E+00,-0.28537E+00,-0.28520E+00,-0.28502E+00, + &-0.28485E+00,-0.28468E+00,-0.28450E+00,-0.28433E+00,-0.28415E+00, + &-0.28398E+00,-0.28381E+00,-0.28363E+00,-0.28346E+00,-0.28329E+00/ + + DATA (BNC06M (I),I=201,300)/ + &-0.28312E+00,-0.28295E+00,-0.28277E+00,-0.28260E+00,-0.28243E+00, + &-0.28226E+00,-0.28209E+00,-0.28192E+00,-0.28175E+00,-0.28158E+00, + &-0.28141E+00,-0.28124E+00,-0.28107E+00,-0.28090E+00,-0.28074E+00, + &-0.28057E+00,-0.28040E+00,-0.28023E+00,-0.28007E+00,-0.27990E+00, + &-0.27974E+00,-0.27957E+00,-0.27941E+00,-0.27924E+00,-0.27908E+00, + &-0.27892E+00,-0.27875E+00,-0.27859E+00,-0.27843E+00,-0.27827E+00, + &-0.27810E+00,-0.27794E+00,-0.27778E+00,-0.27762E+00,-0.27746E+00, + &-0.27731E+00,-0.27715E+00,-0.27699E+00,-0.27683E+00,-0.27667E+00, + &-0.27652E+00,-0.27636E+00,-0.27621E+00,-0.27605E+00,-0.27590E+00, + &-0.27574E+00,-0.27559E+00,-0.27544E+00,-0.27529E+00,-0.27513E+00, + &-0.27498E+00,-0.27483E+00,-0.27468E+00,-0.27453E+00,-0.27438E+00, + &-0.27424E+00,-0.27409E+00,-0.27394E+00,-0.27379E+00,-0.27365E+00, + &-0.27350E+00,-0.27336E+00,-0.27321E+00,-0.27307E+00,-0.27292E+00, + &-0.27278E+00,-0.27264E+00,-0.27250E+00,-0.27236E+00,-0.27222E+00, + &-0.27208E+00,-0.27194E+00,-0.27180E+00,-0.27166E+00,-0.27152E+00, + &-0.27139E+00,-0.27125E+00,-0.27111E+00,-0.27098E+00,-0.27084E+00, + &-0.27071E+00,-0.27058E+00,-0.27044E+00,-0.27031E+00,-0.27018E+00, + &-0.27005E+00,-0.26992E+00,-0.26979E+00,-0.26966E+00,-0.26953E+00, + &-0.26940E+00,-0.26927E+00,-0.26915E+00,-0.26902E+00,-0.26890E+00, + &-0.26877E+00,-0.26865E+00,-0.26852E+00,-0.26840E+00,-0.26828E+00/ + + DATA (BNC06M (I),I=301,400)/ + &-0.26815E+00,-0.26803E+00,-0.26791E+00,-0.26779E+00,-0.26767E+00, + &-0.26755E+00,-0.26744E+00,-0.26732E+00,-0.26720E+00,-0.26708E+00, + &-0.26697E+00,-0.26685E+00,-0.26674E+00,-0.26662E+00,-0.26651E+00, + &-0.26640E+00,-0.26629E+00,-0.26617E+00,-0.26606E+00,-0.26595E+00, + &-0.26584E+00,-0.26573E+00,-0.26563E+00,-0.26552E+00,-0.26541E+00, + &-0.26530E+00,-0.26520E+00,-0.26509E+00,-0.26499E+00,-0.26488E+00, + &-0.26478E+00,-0.26468E+00,-0.26457E+00,-0.26447E+00,-0.26437E+00, + &-0.26427E+00,-0.26417E+00,-0.26407E+00,-0.26397E+00,-0.26387E+00, + &-0.26378E+00,-0.26368E+00,-0.26358E+00,-0.26349E+00,-0.26339E+00, + &-0.26330E+00,-0.26320E+00,-0.26311E+00,-0.26302E+00,-0.26293E+00, + &-0.26284E+00,-0.26274E+00,-0.26265E+00,-0.26256E+00,-0.26248E+00, + &-0.26239E+00,-0.26230E+00,-0.26221E+00,-0.26213E+00,-0.26204E+00, + &-0.26195E+00,-0.26187E+00,-0.26178E+00,-0.26170E+00,-0.26162E+00, + &-0.26154E+00,-0.26145E+00,-0.26137E+00,-0.26129E+00,-0.26121E+00, + &-0.26113E+00,-0.26105E+00,-0.26098E+00,-0.26090E+00,-0.26082E+00, + &-0.26074E+00,-0.26067E+00,-0.26059E+00,-0.26052E+00,-0.26044E+00, + &-0.26037E+00,-0.26030E+00,-0.26023E+00,-0.26015E+00,-0.26008E+00, + &-0.26001E+00,-0.25994E+00,-0.25987E+00,-0.25980E+00,-0.25973E+00, + &-0.25967E+00,-0.25960E+00,-0.25953E+00,-0.25947E+00,-0.25940E+00, + &-0.25934E+00,-0.25927E+00,-0.25921E+00,-0.25915E+00,-0.25908E+00/ + + DATA (BNC06M (I),I=401,500)/ + &-0.25902E+00,-0.25896E+00,-0.25890E+00,-0.25884E+00,-0.25878E+00, + &-0.25872E+00,-0.25866E+00,-0.25860E+00,-0.25855E+00,-0.25849E+00, + &-0.25843E+00,-0.25838E+00,-0.25832E+00,-0.25827E+00,-0.25821E+00, + &-0.25816E+00,-0.25811E+00,-0.25805E+00,-0.25800E+00,-0.25795E+00, + &-0.25790E+00,-0.25785E+00,-0.25780E+00,-0.25775E+00,-0.25770E+00, + &-0.25765E+00,-0.25761E+00,-0.25756E+00,-0.25751E+00,-0.25747E+00, + &-0.25742E+00,-0.25738E+00,-0.25733E+00,-0.25729E+00,-0.25725E+00, + &-0.25721E+00,-0.25716E+00,-0.25712E+00,-0.25708E+00,-0.25704E+00, + &-0.25700E+00,-0.25696E+00,-0.25692E+00,-0.25688E+00,-0.25685E+00, + &-0.25681E+00,-0.25677E+00,-0.25674E+00,-0.25670E+00,-0.25667E+00, + &-0.25663E+00,-0.25660E+00,-0.25656E+00,-0.25653E+00,-0.25650E+00, + &-0.25647E+00,-0.25644E+00,-0.25640E+00,-0.25637E+00,-0.25634E+00, + &-0.25632E+00,-0.25629E+00,-0.25626E+00,-0.25623E+00,-0.25620E+00, + &-0.25618E+00,-0.25615E+00,-0.25612E+00,-0.25610E+00,-0.25608E+00, + &-0.25605E+00,-0.25603E+00,-0.25600E+00,-0.25598E+00,-0.25596E+00, + &-0.25594E+00,-0.25592E+00,-0.25590E+00,-0.25588E+00,-0.25586E+00, + &-0.25584E+00,-0.25582E+00,-0.25580E+00,-0.25578E+00,-0.25577E+00, + &-0.25575E+00,-0.25573E+00,-0.25572E+00,-0.25570E+00,-0.25569E+00, + &-0.25567E+00,-0.25566E+00,-0.25565E+00,-0.25563E+00,-0.25562E+00, + &-0.25561E+00,-0.25560E+00,-0.25559E+00,-0.25558E+00,-0.25557E+00/ + + DATA (BNC06M (I),I=501,600)/ + &-0.25556E+00,-0.25555E+00,-0.25554E+00,-0.25553E+00,-0.25553E+00, + &-0.25552E+00,-0.25551E+00,-0.25551E+00,-0.25550E+00,-0.25550E+00, + &-0.25549E+00,-0.25549E+00,-0.25549E+00,-0.25548E+00,-0.25548E+00, + &-0.25548E+00,-0.25548E+00,-0.25548E+00,-0.25547E+00,-0.25547E+00, + &-0.25547E+00,-0.25548E+00,-0.25548E+00,-0.25548E+00,-0.25548E+00, + &-0.25548E+00,-0.25549E+00,-0.25549E+00,-0.25549E+00,-0.25550E+00, + &-0.25550E+00,-0.25551E+00,-0.25551E+00,-0.25552E+00,-0.25553E+00, + &-0.25553E+00,-0.25554E+00,-0.25555E+00,-0.25556E+00,-0.25557E+00, + &-0.25558E+00,-0.25559E+00,-0.25560E+00,-0.25561E+00,-0.25562E+00, + &-0.25563E+00,-0.25564E+00,-0.25565E+00,-0.25567E+00,-0.25568E+00, + &-0.25569E+00,-0.25571E+00,-0.25572E+00,-0.25574E+00,-0.25575E+00, + &-0.25577E+00,-0.25579E+00,-0.25580E+00,-0.25582E+00,-0.25584E+00, + &-0.25586E+00,-0.25588E+00,-0.25589E+00,-0.25591E+00,-0.25593E+00, + &-0.25595E+00,-0.25597E+00,-0.25600E+00,-0.25602E+00,-0.25604E+00, + &-0.25606E+00,-0.25609E+00,-0.25611E+00,-0.25613E+00,-0.25616E+00, + &-0.25618E+00,-0.25621E+00,-0.25623E+00,-0.25626E+00,-0.25628E+00, + &-0.25631E+00,-0.25634E+00,-0.25637E+00,-0.25639E+00,-0.25642E+00, + &-0.25645E+00,-0.25648E+00,-0.25651E+00,-0.25654E+00,-0.25657E+00, + &-0.25660E+00,-0.25663E+00,-0.25666E+00,-0.25670E+00,-0.25673E+00, + &-0.25676E+00,-0.25679E+00,-0.25683E+00,-0.25686E+00,-0.25699E+00/ + + DATA (BNC06M (I),I=601,700)/ + &-0.25730E+00,-0.25771E+00,-0.25816E+00,-0.25865E+00,-0.25917E+00, + &-0.25973E+00,-0.26033E+00,-0.26096E+00,-0.26163E+00,-0.26233E+00, + &-0.26307E+00,-0.26383E+00,-0.26463E+00,-0.26547E+00,-0.26633E+00, + &-0.26722E+00,-0.26815E+00,-0.26910E+00,-0.27009E+00,-0.27110E+00, + &-0.27214E+00,-0.27320E+00,-0.27430E+00,-0.27542E+00,-0.27657E+00, + &-0.27774E+00,-0.27894E+00,-0.28017E+00,-0.28142E+00,-0.28269E+00, + &-0.28399E+00,-0.28531E+00,-0.28666E+00,-0.28803E+00,-0.28942E+00, + &-0.29083E+00,-0.29226E+00,-0.29372E+00,-0.29520E+00,-0.29669E+00, + &-0.29821E+00,-0.29975E+00,-0.30131E+00,-0.30289E+00,-0.30449E+00, + &-0.30610E+00,-0.30774E+00,-0.30939E+00,-0.31107E+00,-0.31276E+00, + &-0.31447E+00,-0.31619E+00,-0.31794E+00,-0.31970E+00,-0.32147E+00, + &-0.32327E+00,-0.32508E+00,-0.32690E+00,-0.32875E+00,-0.33060E+00, + &-0.33248E+00,-0.33437E+00,-0.33627E+00,-0.33819E+00,-0.34012E+00, + &-0.34207E+00,-0.34403E+00,-0.34601E+00,-0.34800E+00,-0.35001E+00, + &-0.35203E+00,-0.35406E+00,-0.35610E+00,-0.35816E+00,-0.36023E+00, + &-0.36232E+00,-0.36441E+00,-0.36652E+00,-0.36864E+00,-0.37078E+00, + &-0.37292E+00,-0.37508E+00,-0.37725E+00,-0.37943E+00,-0.38162E+00, + &-0.38383E+00,-0.38604E+00,-0.38827E+00,-0.39051E+00,-0.39275E+00, + &-0.39501E+00,-0.39728E+00,-0.39956E+00,-0.40185E+00,-0.40415E+00, + &-0.40646E+00,-0.40879E+00,-0.41112E+00,-0.41346E+00,-0.41581E+00/ + + DATA (BNC06M(I),I=701,741)/ + &-0.41817E+00,-0.42054E+00,-0.42292E+00,-0.42530E+00,-0.42770E+00, + &-0.43011E+00,-0.43252E+00,-0.43495E+00,-0.43738E+00,-0.43982E+00, + &-0.44227E+00,-0.44473E+00,-0.44720E+00,-0.44967E+00,-0.45216E+00, + &-0.45465E+00,-0.45715E+00,-0.45966E+00,-0.46218E+00,-0.46470E+00, + &-0.46723E+00,-0.46977E+00,-0.47232E+00,-0.47487E+00,-0.47744E+00, + &-0.48001E+00,-0.48258E+00,-0.48517E+00,-0.48776E+00,-0.49036E+00, + &-0.49296E+00,-0.49558E+00,-0.49820E+00,-0.50082E+00,-0.50346E+00, + &-0.50610E+00,-0.50874E+00,-0.51140E+00,-0.51406E+00,-0.51672E+00, + &-0.51940E+00 + & / +C +C *** (2H, SO4) +C + DATA (BNC07M (I),I= 1,100)/ + &-0.11102E+00,-0.20302E+00,-0.26840E+00,-0.31329E+00,-0.34815E+00, + &-0.37690E+00,-0.40149E+00,-0.42304E+00,-0.44227E+00,-0.45966E+00, + &-0.47555E+00,-0.49020E+00,-0.50381E+00,-0.51652E+00,-0.52846E+00, + &-0.53971E+00,-0.55037E+00,-0.56050E+00,-0.57015E+00,-0.57937E+00, + &-0.58821E+00,-0.59669E+00,-0.60484E+00,-0.61271E+00,-0.62030E+00, + &-0.62763E+00,-0.63474E+00,-0.64162E+00,-0.64831E+00,-0.65480E+00, + &-0.66112E+00,-0.66727E+00,-0.67327E+00,-0.67912E+00,-0.68483E+00, + &-0.69041E+00,-0.69586E+00,-0.70120E+00,-0.70642E+00,-0.71154E+00, + &-0.71656E+00,-0.72147E+00,-0.72630E+00,-0.73104E+00,-0.73570E+00, + &-0.74027E+00,-0.74477E+00,-0.74919E+00,-0.75354E+00,-0.75782E+00, + &-0.76204E+00,-0.76619E+00,-0.77029E+00,-0.77432E+00,-0.77830E+00, + &-0.78222E+00,-0.78609E+00,-0.78991E+00,-0.79369E+00,-0.79741E+00, + &-0.80109E+00,-0.80472E+00,-0.80832E+00,-0.81187E+00,-0.81538E+00, + &-0.81885E+00,-0.82229E+00,-0.82569E+00,-0.82905E+00,-0.83239E+00, + &-0.83568E+00,-0.83895E+00,-0.84219E+00,-0.84539E+00,-0.84857E+00, + &-0.85172E+00,-0.85484E+00,-0.85793E+00,-0.86100E+00,-0.86405E+00, + &-0.86706E+00,-0.87006E+00,-0.87303E+00,-0.87598E+00,-0.87891E+00, + &-0.88182E+00,-0.88471E+00,-0.88757E+00,-0.89042E+00,-0.89325E+00, + &-0.89605E+00,-0.89885E+00,-0.90162E+00,-0.90437E+00,-0.90711E+00, + &-0.90983E+00,-0.91254E+00,-0.91522E+00,-0.91790E+00,-0.92056E+00/ + + DATA (BNC07M (I),I=101,200)/ + &-0.92320E+00,-0.92583E+00,-0.92844E+00,-0.93104E+00,-0.93362E+00, + &-0.93619E+00,-0.93875E+00,-0.94129E+00,-0.94382E+00,-0.94634E+00, + &-0.94885E+00,-0.95134E+00,-0.95382E+00,-0.95629E+00,-0.95874E+00, + &-0.96119E+00,-0.96362E+00,-0.96604E+00,-0.96845E+00,-0.97085E+00, + &-0.97321E+00,-0.97559E+00,-0.97796E+00,-0.98032E+00,-0.98267E+00, + &-0.98500E+00,-0.98733E+00,-0.98965E+00,-0.99196E+00,-0.99425E+00, + &-0.99654E+00,-0.99882E+00,-0.10011E+01,-0.10033E+01,-0.10056E+01, + &-0.10078E+01,-0.10101E+01,-0.10123E+01,-0.10145E+01,-0.10167E+01, + &-0.10189E+01,-0.10211E+01,-0.10233E+01,-0.10255E+01,-0.10276E+01, + &-0.10298E+01,-0.10319E+01,-0.10341E+01,-0.10362E+01,-0.10383E+01, + &-0.10405E+01,-0.10426E+01,-0.10447E+01,-0.10468E+01,-0.10489E+01, + &-0.10509E+01,-0.10530E+01,-0.10551E+01,-0.10572E+01,-0.10592E+01, + &-0.10613E+01,-0.10633E+01,-0.10653E+01,-0.10674E+01,-0.10694E+01, + &-0.10714E+01,-0.10734E+01,-0.10754E+01,-0.10775E+01,-0.10794E+01, + &-0.10814E+01,-0.10834E+01,-0.10854E+01,-0.10874E+01,-0.10893E+01, + &-0.10913E+01,-0.10933E+01,-0.10952E+01,-0.10972E+01,-0.10991E+01, + &-0.11010E+01,-0.11030E+01,-0.11049E+01,-0.11068E+01,-0.11087E+01, + &-0.11106E+01,-0.11126E+01,-0.11145E+01,-0.11164E+01,-0.11182E+01, + &-0.11201E+01,-0.11220E+01,-0.11239E+01,-0.11258E+01,-0.11276E+01, + &-0.11295E+01,-0.11314E+01,-0.11332E+01,-0.11351E+01,-0.11369E+01/ + + DATA (BNC07M (I),I=201,300)/ + &-0.11388E+01,-0.11406E+01,-0.11424E+01,-0.11443E+01,-0.11461E+01, + &-0.11479E+01,-0.11497E+01,-0.11516E+01,-0.11534E+01,-0.11552E+01, + &-0.11570E+01,-0.11588E+01,-0.11606E+01,-0.11624E+01,-0.11642E+01, + &-0.11659E+01,-0.11677E+01,-0.11695E+01,-0.11713E+01,-0.11730E+01, + &-0.11748E+01,-0.11766E+01,-0.11783E+01,-0.11801E+01,-0.11819E+01, + &-0.11836E+01,-0.11853E+01,-0.11871E+01,-0.11888E+01,-0.11906E+01, + &-0.11923E+01,-0.11940E+01,-0.11958E+01,-0.11975E+01,-0.11992E+01, + &-0.12009E+01,-0.12026E+01,-0.12044E+01,-0.12061E+01,-0.12078E+01, + &-0.12095E+01,-0.12112E+01,-0.12129E+01,-0.12146E+01,-0.12163E+01, + &-0.12179E+01,-0.12196E+01,-0.12213E+01,-0.12230E+01,-0.12247E+01, + &-0.12263E+01,-0.12280E+01,-0.12297E+01,-0.12313E+01,-0.12330E+01, + &-0.12347E+01,-0.12363E+01,-0.12380E+01,-0.12396E+01,-0.12413E+01, + &-0.12429E+01,-0.12446E+01,-0.12462E+01,-0.12479E+01,-0.12495E+01, + &-0.12511E+01,-0.12528E+01,-0.12544E+01,-0.12560E+01,-0.12577E+01, + &-0.12593E+01,-0.12609E+01,-0.12625E+01,-0.12641E+01,-0.12658E+01, + &-0.12674E+01,-0.12690E+01,-0.12706E+01,-0.12722E+01,-0.12738E+01, + &-0.12754E+01,-0.12770E+01,-0.12786E+01,-0.12802E+01,-0.12818E+01, + &-0.12834E+01,-0.12849E+01,-0.12865E+01,-0.12881E+01,-0.12897E+01, + &-0.12913E+01,-0.12929E+01,-0.12944E+01,-0.12960E+01,-0.12976E+01, + &-0.12991E+01,-0.13007E+01,-0.13023E+01,-0.13038E+01,-0.13054E+01/ + + DATA (BNC07M (I),I=301,400)/ + &-0.13070E+01,-0.13085E+01,-0.13101E+01,-0.13116E+01,-0.13132E+01, + &-0.13147E+01,-0.13163E+01,-0.13178E+01,-0.13194E+01,-0.13209E+01, + &-0.13224E+01,-0.13240E+01,-0.13255E+01,-0.13271E+01,-0.13286E+01, + &-0.13301E+01,-0.13316E+01,-0.13332E+01,-0.13347E+01,-0.13362E+01, + &-0.13378E+01,-0.13393E+01,-0.13408E+01,-0.13423E+01,-0.13438E+01, + &-0.13453E+01,-0.13468E+01,-0.13484E+01,-0.13499E+01,-0.13514E+01, + &-0.13529E+01,-0.13544E+01,-0.13559E+01,-0.13574E+01,-0.13589E+01, + &-0.13604E+01,-0.13619E+01,-0.13634E+01,-0.13649E+01,-0.13664E+01, + &-0.13679E+01,-0.13693E+01,-0.13708E+01,-0.13723E+01,-0.13738E+01, + &-0.13753E+01,-0.13768E+01,-0.13782E+01,-0.13797E+01,-0.13812E+01, + &-0.13827E+01,-0.13841E+01,-0.13856E+01,-0.13871E+01,-0.13886E+01, + &-0.13900E+01,-0.13915E+01,-0.13930E+01,-0.13944E+01,-0.13959E+01, + &-0.13973E+01,-0.13988E+01,-0.14003E+01,-0.14017E+01,-0.14032E+01, + &-0.14046E+01,-0.14061E+01,-0.14075E+01,-0.14090E+01,-0.14104E+01, + &-0.14119E+01,-0.14133E+01,-0.14148E+01,-0.14162E+01,-0.14176E+01, + &-0.14191E+01,-0.14205E+01,-0.14220E+01,-0.14234E+01,-0.14248E+01, + &-0.14263E+01,-0.14277E+01,-0.14291E+01,-0.14306E+01,-0.14320E+01, + &-0.14334E+01,-0.14349E+01,-0.14363E+01,-0.14377E+01,-0.14391E+01, + &-0.14406E+01,-0.14420E+01,-0.14434E+01,-0.14448E+01,-0.14462E+01, + &-0.14476E+01,-0.14491E+01,-0.14505E+01,-0.14519E+01,-0.14533E+01/ + + DATA (BNC07M (I),I=401,500)/ + &-0.14547E+01,-0.14561E+01,-0.14575E+01,-0.14589E+01,-0.14603E+01, + &-0.14617E+01,-0.14631E+01,-0.14646E+01,-0.14660E+01,-0.14674E+01, + &-0.14688E+01,-0.14702E+01,-0.14715E+01,-0.14729E+01,-0.14743E+01, + &-0.14757E+01,-0.14771E+01,-0.14785E+01,-0.14799E+01,-0.14813E+01, + &-0.14827E+01,-0.14841E+01,-0.14855E+01,-0.14868E+01,-0.14882E+01, + &-0.14896E+01,-0.14910E+01,-0.14924E+01,-0.14938E+01,-0.14951E+01, + &-0.14965E+01,-0.14979E+01,-0.14993E+01,-0.15007E+01,-0.15020E+01, + &-0.15034E+01,-0.15048E+01,-0.15061E+01,-0.15075E+01,-0.15089E+01, + &-0.15103E+01,-0.15116E+01,-0.15130E+01,-0.15144E+01,-0.15157E+01, + &-0.15171E+01,-0.15184E+01,-0.15198E+01,-0.15212E+01,-0.15225E+01, + &-0.15239E+01,-0.15252E+01,-0.15266E+01,-0.15280E+01,-0.15293E+01, + &-0.15307E+01,-0.15320E+01,-0.15334E+01,-0.15347E+01,-0.15361E+01, + &-0.15374E+01,-0.15388E+01,-0.15401E+01,-0.15415E+01,-0.15428E+01, + &-0.15442E+01,-0.15455E+01,-0.15469E+01,-0.15482E+01,-0.15495E+01, + &-0.15509E+01,-0.15522E+01,-0.15536E+01,-0.15549E+01,-0.15562E+01, + &-0.15576E+01,-0.15589E+01,-0.15603E+01,-0.15616E+01,-0.15629E+01, + &-0.15643E+01,-0.15656E+01,-0.15669E+01,-0.15683E+01,-0.15696E+01, + &-0.15709E+01,-0.15722E+01,-0.15736E+01,-0.15749E+01,-0.15762E+01, + &-0.15776E+01,-0.15789E+01,-0.15802E+01,-0.15815E+01,-0.15828E+01, + &-0.15842E+01,-0.15855E+01,-0.15868E+01,-0.15881E+01,-0.15894E+01/ + + DATA (BNC07M (I),I=501,600)/ + &-0.15908E+01,-0.15921E+01,-0.15934E+01,-0.15947E+01,-0.15960E+01, + &-0.15973E+01,-0.15987E+01,-0.16000E+01,-0.16013E+01,-0.16026E+01, + &-0.16039E+01,-0.16052E+01,-0.16065E+01,-0.16078E+01,-0.16091E+01, + &-0.16104E+01,-0.16117E+01,-0.16131E+01,-0.16144E+01,-0.16157E+01, + &-0.16170E+01,-0.16183E+01,-0.16196E+01,-0.16209E+01,-0.16222E+01, + &-0.16235E+01,-0.16248E+01,-0.16261E+01,-0.16274E+01,-0.16287E+01, + &-0.16300E+01,-0.16313E+01,-0.16325E+01,-0.16338E+01,-0.16351E+01, + &-0.16364E+01,-0.16377E+01,-0.16390E+01,-0.16403E+01,-0.16416E+01, + &-0.16429E+01,-0.16442E+01,-0.16455E+01,-0.16467E+01,-0.16480E+01, + &-0.16493E+01,-0.16506E+01,-0.16519E+01,-0.16532E+01,-0.16545E+01, + &-0.16557E+01,-0.16570E+01,-0.16583E+01,-0.16596E+01,-0.16609E+01, + &-0.16621E+01,-0.16634E+01,-0.16647E+01,-0.16660E+01,-0.16673E+01, + &-0.16685E+01,-0.16698E+01,-0.16711E+01,-0.16724E+01,-0.16736E+01, + &-0.16749E+01,-0.16762E+01,-0.16775E+01,-0.16787E+01,-0.16800E+01, + &-0.16813E+01,-0.16825E+01,-0.16838E+01,-0.16851E+01,-0.16863E+01, + &-0.16876E+01,-0.16889E+01,-0.16902E+01,-0.16914E+01,-0.16927E+01, + &-0.16939E+01,-0.16952E+01,-0.16965E+01,-0.16977E+01,-0.16990E+01, + &-0.17003E+01,-0.17015E+01,-0.17028E+01,-0.17040E+01,-0.17053E+01, + &-0.17066E+01,-0.17078E+01,-0.17091E+01,-0.17103E+01,-0.17116E+01, + &-0.17129E+01,-0.17141E+01,-0.17154E+01,-0.17166E+01,-0.17213E+01/ + + DATA (BNC07M (I),I=601,700)/ + &-0.17316E+01,-0.17441E+01,-0.17565E+01,-0.17688E+01,-0.17811E+01, + &-0.17934E+01,-0.18056E+01,-0.18178E+01,-0.18299E+01,-0.18420E+01, + &-0.18540E+01,-0.18660E+01,-0.18780E+01,-0.18899E+01,-0.19018E+01, + &-0.19136E+01,-0.19254E+01,-0.19372E+01,-0.19489E+01,-0.19607E+01, + &-0.19723E+01,-0.19840E+01,-0.19956E+01,-0.20072E+01,-0.20187E+01, + &-0.20302E+01,-0.20417E+01,-0.20532E+01,-0.20646E+01,-0.20760E+01, + &-0.20874E+01,-0.20988E+01,-0.21101E+01,-0.21214E+01,-0.21327E+01, + &-0.21440E+01,-0.21552E+01,-0.21664E+01,-0.21776E+01,-0.21888E+01, + &-0.21999E+01,-0.22110E+01,-0.22221E+01,-0.22332E+01,-0.22443E+01, + &-0.22553E+01,-0.22663E+01,-0.22773E+01,-0.22883E+01,-0.22992E+01, + &-0.23102E+01,-0.23211E+01,-0.23320E+01,-0.23429E+01,-0.23537E+01, + &-0.23646E+01,-0.23754E+01,-0.23862E+01,-0.23970E+01,-0.24078E+01, + &-0.24186E+01,-0.24293E+01,-0.24401E+01,-0.24508E+01,-0.24615E+01, + &-0.24722E+01,-0.24828E+01,-0.24935E+01,-0.25041E+01,-0.25148E+01, + &-0.25254E+01,-0.25360E+01,-0.25466E+01,-0.25571E+01,-0.25677E+01, + &-0.25782E+01,-0.25888E+01,-0.25993E+01,-0.26098E+01,-0.26203E+01, + &-0.26308E+01,-0.26412E+01,-0.26517E+01,-0.26621E+01,-0.26726E+01, + &-0.26830E+01,-0.26934E+01,-0.27038E+01,-0.27142E+01,-0.27245E+01, + &-0.27349E+01,-0.27453E+01,-0.27556E+01,-0.27659E+01,-0.27762E+01, + &-0.27866E+01,-0.27968E+01,-0.28071E+01,-0.28174E+01,-0.28277E+01/ + + DATA (BNC07M(I),I=701,741)/ + &-0.28379E+01,-0.28482E+01,-0.28584E+01,-0.28686E+01,-0.28788E+01, + &-0.28891E+01,-0.28992E+01,-0.29094E+01,-0.29196E+01,-0.29298E+01, + &-0.29399E+01,-0.29501E+01,-0.29602E+01,-0.29704E+01,-0.29805E+01, + &-0.29906E+01,-0.30007E+01,-0.30108E+01,-0.30209E+01,-0.30310E+01, + &-0.30410E+01,-0.30511E+01,-0.30612E+01,-0.30712E+01,-0.30812E+01, + &-0.30913E+01,-0.31013E+01,-0.31113E+01,-0.31213E+01,-0.31313E+01, + &-0.31413E+01,-0.31513E+01,-0.31613E+01,-0.31712E+01,-0.31812E+01, + &-0.31911E+01,-0.32011E+01,-0.32110E+01,-0.32210E+01,-0.32309E+01, + &-0.32408E+01 + & / +C +C *** (H, HSO4) +C + DATA (BNC08M (I),I= 1,100)/ + &-0.51043E-01,-0.86042E-01,-0.10613E+00,-0.11710E+00,-0.12372E+00, + &-0.12771E+00,-0.12990E+00,-0.13078E+00,-0.13062E+00,-0.12964E+00, + &-0.12796E+00,-0.12569E+00,-0.12291E+00,-0.11967E+00,-0.11602E+00, + &-0.11201E+00,-0.10765E+00,-0.10298E+00,-0.98013E-01,-0.92777E-01, + &-0.87285E-01,-0.81552E-01,-0.75590E-01,-0.69411E-01,-0.63026E-01, + &-0.56444E-01,-0.49675E-01,-0.42726E-01,-0.35606E-01,-0.28321E-01, + &-0.20880E-01,-0.13287E-01,-0.55488E-02, 0.23277E-02, 0.10337E-01, + & 0.18475E-01, 0.26735E-01, 0.35113E-01, 0.43603E-01, 0.52201E-01, + & 0.60903E-01, 0.69703E-01, 0.78599E-01, 0.87586E-01, 0.96660E-01, + & 0.10582E+00, 0.11506E+00, 0.12437E+00, 0.13376E+00, 0.14322E+00, + & 0.15274E+00, 0.16233E+00, 0.17199E+00, 0.18170E+00, 0.19147E+00, + & 0.20130E+00, 0.21119E+00, 0.22112E+00, 0.23111E+00, 0.24115E+00, + & 0.25124E+00, 0.26138E+00, 0.27157E+00, 0.28181E+00, 0.29209E+00, + & 0.30242E+00, 0.31280E+00, 0.32323E+00, 0.33370E+00, 0.34422E+00, + & 0.35480E+00, 0.36542E+00, 0.37609E+00, 0.38682E+00, 0.39759E+00, + & 0.40842E+00, 0.41931E+00, 0.43025E+00, 0.44124E+00, 0.45229E+00, + & 0.46340E+00, 0.47456E+00, 0.48578E+00, 0.49706E+00, 0.50840E+00, + & 0.51980E+00, 0.53126E+00, 0.54278E+00, 0.55435E+00, 0.56599E+00, + & 0.57768E+00, 0.58943E+00, 0.60124E+00, 0.61310E+00, 0.62502E+00, + & 0.63700E+00, 0.64902E+00, 0.66110E+00, 0.67322E+00, 0.68539E+00/ + + DATA (BNC08M (I),I=101,200)/ + & 0.69761E+00, 0.70987E+00, 0.72217E+00, 0.73451E+00, 0.74689E+00, + & 0.75930E+00, 0.77174E+00, 0.78422E+00, 0.79672E+00, 0.80925E+00, + & 0.82180E+00, 0.83437E+00, 0.84696E+00, 0.85957E+00, 0.87219E+00, + & 0.88482E+00, 0.89747E+00, 0.91012E+00, 0.92278E+00, 0.93544E+00, + & 0.94702E+00, 0.95981E+00, 0.97259E+00, 0.98535E+00, 0.99809E+00, + & 0.10108E+01, 0.10235E+01, 0.10362E+01, 0.10489E+01, 0.10616E+01, + & 0.10742E+01, 0.10869E+01, 0.10995E+01, 0.11121E+01, 0.11246E+01, + & 0.11372E+01, 0.11497E+01, 0.11622E+01, 0.11747E+01, 0.11872E+01, + & 0.11997E+01, 0.12121E+01, 0.12245E+01, 0.12369E+01, 0.12493E+01, + & 0.12616E+01, 0.12739E+01, 0.12862E+01, 0.12985E+01, 0.13108E+01, + & 0.13230E+01, 0.13352E+01, 0.13474E+01, 0.13595E+01, 0.13717E+01, + & 0.13838E+01, 0.13959E+01, 0.14079E+01, 0.14200E+01, 0.14320E+01, + & 0.14440E+01, 0.14559E+01, 0.14679E+01, 0.14798E+01, 0.14917E+01, + & 0.15036E+01, 0.15154E+01, 0.15272E+01, 0.15390E+01, 0.15508E+01, + & 0.15625E+01, 0.15742E+01, 0.15859E+01, 0.15976E+01, 0.16092E+01, + & 0.16209E+01, 0.16325E+01, 0.16440E+01, 0.16556E+01, 0.16671E+01, + & 0.16786E+01, 0.16900E+01, 0.17015E+01, 0.17129E+01, 0.17243E+01, + & 0.17356E+01, 0.17470E+01, 0.17583E+01, 0.17696E+01, 0.17809E+01, + & 0.17921E+01, 0.18033E+01, 0.18145E+01, 0.18257E+01, 0.18368E+01, + & 0.18479E+01, 0.18590E+01, 0.18701E+01, 0.18811E+01, 0.18921E+01/ + + DATA (BNC08M (I),I=201,300)/ + & 0.19031E+01, 0.19141E+01, 0.19250E+01, 0.19360E+01, 0.19468E+01, + & 0.19577E+01, 0.19686E+01, 0.19794E+01, 0.19902E+01, 0.20009E+01, + & 0.20117E+01, 0.20224E+01, 0.20331E+01, 0.20438E+01, 0.20544E+01, + & 0.20651E+01, 0.20757E+01, 0.20863E+01, 0.20968E+01, 0.21073E+01, + & 0.21179E+01, 0.21283E+01, 0.21388E+01, 0.21492E+01, 0.21597E+01, + & 0.21700E+01, 0.21804E+01, 0.21908E+01, 0.22011E+01, 0.22114E+01, + & 0.22217E+01, 0.22319E+01, 0.22422E+01, 0.22524E+01, 0.22625E+01, + & 0.22727E+01, 0.22829E+01, 0.22930E+01, 0.23031E+01, 0.23131E+01, + & 0.23232E+01, 0.23332E+01, 0.23432E+01, 0.23532E+01, 0.23632E+01, + & 0.23731E+01, 0.23830E+01, 0.23929E+01, 0.24028E+01, 0.24127E+01, + & 0.24225E+01, 0.24323E+01, 0.24421E+01, 0.24519E+01, 0.24616E+01, + & 0.24714E+01, 0.24811E+01, 0.24908E+01, 0.25004E+01, 0.25101E+01, + & 0.25197E+01, 0.25293E+01, 0.25389E+01, 0.25484E+01, 0.25580E+01, + & 0.25675E+01, 0.25770E+01, 0.25865E+01, 0.25960E+01, 0.26054E+01, + & 0.26148E+01, 0.26242E+01, 0.26336E+01, 0.26430E+01, 0.26523E+01, + & 0.26616E+01, 0.26709E+01, 0.26802E+01, 0.26895E+01, 0.26987E+01, + & 0.27079E+01, 0.27171E+01, 0.27263E+01, 0.27355E+01, 0.27446E+01, + & 0.27538E+01, 0.27629E+01, 0.27720E+01, 0.27810E+01, 0.27901E+01, + & 0.27991E+01, 0.28082E+01, 0.28171E+01, 0.28261E+01, 0.28351E+01, + & 0.28440E+01, 0.28530E+01, 0.28619E+01, 0.28707E+01, 0.28796E+01/ + + DATA (BNC08M (I),I=301,400)/ + & 0.28885E+01, 0.28973E+01, 0.29061E+01, 0.29149E+01, 0.29237E+01, + & 0.29325E+01, 0.29412E+01, 0.29499E+01, 0.29586E+01, 0.29673E+01, + & 0.29760E+01, 0.29847E+01, 0.29933E+01, 0.30019E+01, 0.30105E+01, + & 0.30191E+01, 0.30277E+01, 0.30363E+01, 0.30448E+01, 0.30533E+01, + & 0.30618E+01, 0.30703E+01, 0.30788E+01, 0.30872E+01, 0.30957E+01, + & 0.31041E+01, 0.31125E+01, 0.31209E+01, 0.31293E+01, 0.31376E+01, + & 0.31460E+01, 0.31543E+01, 0.31626E+01, 0.31709E+01, 0.31792E+01, + & 0.31874E+01, 0.31957E+01, 0.32039E+01, 0.32121E+01, 0.32203E+01, + & 0.32285E+01, 0.32366E+01, 0.32448E+01, 0.32529E+01, 0.32610E+01, + & 0.32691E+01, 0.32772E+01, 0.32853E+01, 0.32934E+01, 0.33014E+01, + & 0.33094E+01, 0.33175E+01, 0.33254E+01, 0.33334E+01, 0.33414E+01, + & 0.33494E+01, 0.33573E+01, 0.33652E+01, 0.33731E+01, 0.33810E+01, + & 0.33889E+01, 0.33968E+01, 0.34046E+01, 0.34124E+01, 0.34203E+01, + & 0.34281E+01, 0.34359E+01, 0.34436E+01, 0.34514E+01, 0.34592E+01, + & 0.34669E+01, 0.34746E+01, 0.34823E+01, 0.34900E+01, 0.34977E+01, + & 0.35054E+01, 0.35130E+01, 0.35206E+01, 0.35283E+01, 0.35359E+01, + & 0.35435E+01, 0.35511E+01, 0.35586E+01, 0.35662E+01, 0.35737E+01, + & 0.35813E+01, 0.35888E+01, 0.35963E+01, 0.36038E+01, 0.36112E+01, + & 0.36187E+01, 0.36262E+01, 0.36336E+01, 0.36410E+01, 0.36484E+01, + & 0.36558E+01, 0.36632E+01, 0.36706E+01, 0.36779E+01, 0.36853E+01/ + + DATA (BNC08M (I),I=401,500)/ + & 0.36926E+01, 0.36999E+01, 0.37072E+01, 0.37145E+01, 0.37218E+01, + & 0.37291E+01, 0.37363E+01, 0.37436E+01, 0.37508E+01, 0.37580E+01, + & 0.37652E+01, 0.37724E+01, 0.37796E+01, 0.37868E+01, 0.37939E+01, + & 0.38011E+01, 0.38082E+01, 0.38153E+01, 0.38225E+01, 0.38296E+01, + & 0.38366E+01, 0.38437E+01, 0.38508E+01, 0.38578E+01, 0.38649E+01, + & 0.38719E+01, 0.38789E+01, 0.38859E+01, 0.38929E+01, 0.38999E+01, + & 0.39068E+01, 0.39138E+01, 0.39207E+01, 0.39277E+01, 0.39346E+01, + & 0.39415E+01, 0.39484E+01, 0.39553E+01, 0.39622E+01, 0.39690E+01, + & 0.39759E+01, 0.39827E+01, 0.39895E+01, 0.39964E+01, 0.40032E+01, + & 0.40100E+01, 0.40167E+01, 0.40235E+01, 0.40303E+01, 0.40370E+01, + & 0.40438E+01, 0.40505E+01, 0.40572E+01, 0.40639E+01, 0.40706E+01, + & 0.40773E+01, 0.40840E+01, 0.40907E+01, 0.40973E+01, 0.41040E+01, + & 0.41106E+01, 0.41172E+01, 0.41238E+01, 0.41304E+01, 0.41370E+01, + & 0.41436E+01, 0.41502E+01, 0.41567E+01, 0.41633E+01, 0.41698E+01, + & 0.41763E+01, 0.41829E+01, 0.41894E+01, 0.41959E+01, 0.42024E+01, + & 0.42088E+01, 0.42153E+01, 0.42218E+01, 0.42282E+01, 0.42346E+01, + & 0.42411E+01, 0.42475E+01, 0.42539E+01, 0.42603E+01, 0.42667E+01, + & 0.42731E+01, 0.42794E+01, 0.42858E+01, 0.42921E+01, 0.42985E+01, + & 0.43048E+01, 0.43111E+01, 0.43174E+01, 0.43237E+01, 0.43300E+01, + & 0.43363E+01, 0.43426E+01, 0.43488E+01, 0.43551E+01, 0.43613E+01/ + + DATA (BNC08M (I),I=501,600)/ + & 0.43675E+01, 0.43738E+01, 0.43800E+01, 0.43862E+01, 0.43924E+01, + & 0.43986E+01, 0.44047E+01, 0.44109E+01, 0.44171E+01, 0.44232E+01, + & 0.44293E+01, 0.44355E+01, 0.44416E+01, 0.44477E+01, 0.44538E+01, + & 0.44599E+01, 0.44660E+01, 0.44721E+01, 0.44781E+01, 0.44842E+01, + & 0.44902E+01, 0.44963E+01, 0.45023E+01, 0.45083E+01, 0.45143E+01, + & 0.45203E+01, 0.45263E+01, 0.45323E+01, 0.45383E+01, 0.45443E+01, + & 0.45502E+01, 0.45562E+01, 0.45621E+01, 0.45681E+01, 0.45740E+01, + & 0.45799E+01, 0.45858E+01, 0.45917E+01, 0.45976E+01, 0.46035E+01, + & 0.46094E+01, 0.46152E+01, 0.46211E+01, 0.46269E+01, 0.46328E+01, + & 0.46386E+01, 0.46444E+01, 0.46502E+01, 0.46560E+01, 0.46618E+01, + & 0.46676E+01, 0.46734E+01, 0.46792E+01, 0.46849E+01, 0.46907E+01, + & 0.46965E+01, 0.47022E+01, 0.47079E+01, 0.47137E+01, 0.47194E+01, + & 0.47251E+01, 0.47308E+01, 0.47365E+01, 0.47422E+01, 0.47478E+01, + & 0.47535E+01, 0.47592E+01, 0.47648E+01, 0.47705E+01, 0.47761E+01, + & 0.47817E+01, 0.47873E+01, 0.47930E+01, 0.47986E+01, 0.48042E+01, + & 0.48098E+01, 0.48153E+01, 0.48209E+01, 0.48265E+01, 0.48320E+01, + & 0.48376E+01, 0.48431E+01, 0.48487E+01, 0.48542E+01, 0.48597E+01, + & 0.48652E+01, 0.48707E+01, 0.48762E+01, 0.48817E+01, 0.48872E+01, + & 0.48927E+01, 0.48982E+01, 0.49036E+01, 0.49091E+01, 0.49145E+01, + & 0.49200E+01, 0.49254E+01, 0.49308E+01, 0.49362E+01, 0.49565E+01/ + + DATA (BNC08M (I),I=601,700)/ + & 0.50007E+01, 0.50536E+01, 0.51058E+01, 0.51574E+01, 0.52083E+01, + & 0.52585E+01, 0.53082E+01, 0.53572E+01, 0.54056E+01, 0.54534E+01, + & 0.55007E+01, 0.55473E+01, 0.55935E+01, 0.56391E+01, 0.56841E+01, + & 0.57287E+01, 0.57727E+01, 0.58163E+01, 0.58594E+01, 0.59020E+01, + & 0.59441E+01, 0.59858E+01, 0.60270E+01, 0.60678E+01, 0.61081E+01, + & 0.61481E+01, 0.61876E+01, 0.62267E+01, 0.62654E+01, 0.63037E+01, + & 0.63416E+01, 0.63792E+01, 0.64164E+01, 0.64532E+01, 0.64897E+01, + & 0.65258E+01, 0.65615E+01, 0.65969E+01, 0.66320E+01, 0.66668E+01, + & 0.67012E+01, 0.67353E+01, 0.67691E+01, 0.68026E+01, 0.68358E+01, + & 0.68687E+01, 0.69013E+01, 0.69336E+01, 0.69656E+01, 0.69974E+01, + & 0.70288E+01, 0.70600E+01, 0.70910E+01, 0.71216E+01, 0.71520E+01, + & 0.71822E+01, 0.72121E+01, 0.72417E+01, 0.72711E+01, 0.73003E+01, + & 0.73292E+01, 0.73579E+01, 0.73864E+01, 0.74146E+01, 0.74426E+01, + & 0.74704E+01, 0.74980E+01, 0.75253E+01, 0.75524E+01, 0.75794E+01, + & 0.76061E+01, 0.76326E+01, 0.76589E+01, 0.76850E+01, 0.77110E+01, + & 0.77367E+01, 0.77622E+01, 0.77876E+01, 0.78127E+01, 0.78377E+01, + & 0.78625E+01, 0.78871E+01, 0.79115E+01, 0.79358E+01, 0.79599E+01, + & 0.79838E+01, 0.80075E+01, 0.80311E+01, 0.80545E+01, 0.80778E+01, + & 0.81009E+01, 0.81238E+01, 0.81466E+01, 0.81692E+01, 0.81916E+01, + & 0.82140E+01, 0.82361E+01, 0.82581E+01, 0.82800E+01, 0.83017E+01/ + + DATA (BNC08M(I),I=701,741)/ + & 0.83233E+01, 0.83447E+01, 0.83660E+01, 0.83872E+01, 0.84082E+01, + & 0.84291E+01, 0.84498E+01, 0.84704E+01, 0.84909E+01, 0.85113E+01, + & 0.85315E+01, 0.85516E+01, 0.85715E+01, 0.85914E+01, 0.86111E+01, + & 0.86307E+01, 0.86502E+01, 0.86695E+01, 0.86888E+01, 0.87079E+01, + & 0.87269E+01, 0.87458E+01, 0.87645E+01, 0.87832E+01, 0.88018E+01, + & 0.88202E+01, 0.88385E+01, 0.88567E+01, 0.88749E+01, 0.88929E+01, + & 0.89108E+01, 0.89286E+01, 0.89463E+01, 0.89638E+01, 0.89813E+01, + & 0.89987E+01, 0.90160E+01, 0.90332E+01, 0.90503E+01, 0.90673E+01, + & 0.90842E+01 + & / +C +C *** NH4HSO4 +C + DATA (BNC09M (I),I= 1,100)/ + &-0.54181E-01,-0.97084E-01,-0.12639E+00,-0.14587E+00,-0.16057E+00, + &-0.17236E+00,-0.18218E+00,-0.19054E+00,-0.19779E+00,-0.20414E+00, + &-0.20976E+00,-0.21476E+00,-0.21923E+00,-0.22324E+00,-0.22685E+00, + &-0.23009E+00,-0.23301E+00,-0.23563E+00,-0.23798E+00,-0.24008E+00, + &-0.24194E+00,-0.24359E+00,-0.24503E+00,-0.24629E+00,-0.24736E+00, + &-0.24827E+00,-0.24901E+00,-0.24959E+00,-0.25003E+00,-0.25033E+00, + &-0.25049E+00,-0.25052E+00,-0.25043E+00,-0.25022E+00,-0.24990E+00, + &-0.24946E+00,-0.24892E+00,-0.24827E+00,-0.24753E+00,-0.24669E+00, + &-0.24576E+00,-0.24473E+00,-0.24363E+00,-0.24244E+00,-0.24116E+00, + &-0.23982E+00,-0.23839E+00,-0.23690E+00,-0.23533E+00,-0.23370E+00, + &-0.23200E+00,-0.23024E+00,-0.22842E+00,-0.22654E+00,-0.22460E+00, + &-0.22261E+00,-0.22056E+00,-0.21846E+00,-0.21632E+00,-0.21412E+00, + &-0.21188E+00,-0.20959E+00,-0.20725E+00,-0.20487E+00,-0.20245E+00, + &-0.19999E+00,-0.19748E+00,-0.19494E+00,-0.19236E+00,-0.18974E+00, + &-0.18708E+00,-0.18439E+00,-0.18165E+00,-0.17889E+00,-0.17608E+00, + &-0.17324E+00,-0.17037E+00,-0.16746E+00,-0.16452E+00,-0.16154E+00, + &-0.15853E+00,-0.15549E+00,-0.15242E+00,-0.14931E+00,-0.14617E+00, + &-0.14300E+00,-0.13980E+00,-0.13656E+00,-0.13330E+00,-0.13001E+00, + &-0.12668E+00,-0.12333E+00,-0.11995E+00,-0.11655E+00,-0.11311E+00, + &-0.10965E+00,-0.10617E+00,-0.10266E+00,-0.99129E-01,-0.95574E-01/ + + DATA (BNC09M (I),I=101,200)/ + &-0.91997E-01,-0.88400E-01,-0.84784E-01,-0.81148E-01,-0.77495E-01, + &-0.73825E-01,-0.70139E-01,-0.66438E-01,-0.62724E-01,-0.58997E-01, + &-0.55258E-01,-0.51509E-01,-0.47750E-01,-0.43981E-01,-0.40206E-01, + &-0.36423E-01,-0.32634E-01,-0.28839E-01,-0.25041E-01,-0.21238E-01, + &-0.17814E-01,-0.13963E-01,-0.10114E-01,-0.62690E-02,-0.24276E-02, + & 0.14101E-02, 0.52436E-02, 0.90727E-02, 0.12897E-01, 0.16717E-01, + & 0.20532E-01, 0.24341E-01, 0.28145E-01, 0.31943E-01, 0.35736E-01, + & 0.39522E-01, 0.43302E-01, 0.47075E-01, 0.50843E-01, 0.54603E-01, + & 0.58356E-01, 0.62103E-01, 0.65842E-01, 0.69575E-01, 0.73300E-01, + & 0.77017E-01, 0.80727E-01, 0.84429E-01, 0.88124E-01, 0.91811E-01, + & 0.95490E-01, 0.99161E-01, 0.10282E+00, 0.10648E+00, 0.11012E+00, + & 0.11376E+00, 0.11739E+00, 0.12102E+00, 0.12463E+00, 0.12823E+00, + & 0.13183E+00, 0.13542E+00, 0.13900E+00, 0.14257E+00, 0.14613E+00, + & 0.14968E+00, 0.15323E+00, 0.15677E+00, 0.16029E+00, 0.16381E+00, + & 0.16732E+00, 0.17082E+00, 0.17432E+00, 0.17780E+00, 0.18128E+00, + & 0.18474E+00, 0.18820E+00, 0.19165E+00, 0.19509E+00, 0.19852E+00, + & 0.20194E+00, 0.20536E+00, 0.20876E+00, 0.21216E+00, 0.21555E+00, + & 0.21892E+00, 0.22229E+00, 0.22566E+00, 0.22901E+00, 0.23235E+00, + & 0.23569E+00, 0.23902E+00, 0.24233E+00, 0.24564E+00, 0.24894E+00, + & 0.25224E+00, 0.25552E+00, 0.25880E+00, 0.26206E+00, 0.26532E+00/ + + DATA (BNC09M (I),I=201,300)/ + & 0.26857E+00, 0.27181E+00, 0.27505E+00, 0.27827E+00, 0.28149E+00, + & 0.28470E+00, 0.28790E+00, 0.29109E+00, 0.29427E+00, 0.29745E+00, + & 0.30061E+00, 0.30377E+00, 0.30692E+00, 0.31007E+00, 0.31320E+00, + & 0.31633E+00, 0.31944E+00, 0.32255E+00, 0.32566E+00, 0.32875E+00, + & 0.33184E+00, 0.33492E+00, 0.33799E+00, 0.34105E+00, 0.34410E+00, + & 0.34715E+00, 0.35019E+00, 0.35322E+00, 0.35625E+00, 0.35926E+00, + & 0.36227E+00, 0.36527E+00, 0.36827E+00, 0.37125E+00, 0.37423E+00, + & 0.37720E+00, 0.38017E+00, 0.38312E+00, 0.38607E+00, 0.38901E+00, + & 0.39195E+00, 0.39487E+00, 0.39779E+00, 0.40070E+00, 0.40361E+00, + & 0.40651E+00, 0.40940E+00, 0.41228E+00, 0.41516E+00, 0.41803E+00, + & 0.42089E+00, 0.42374E+00, 0.42659E+00, 0.42943E+00, 0.43227E+00, + & 0.43509E+00, 0.43791E+00, 0.44073E+00, 0.44354E+00, 0.44634E+00, + & 0.44913E+00, 0.45192E+00, 0.45469E+00, 0.45747E+00, 0.46023E+00, + & 0.46299E+00, 0.46575E+00, 0.46849E+00, 0.47123E+00, 0.47397E+00, + & 0.47670E+00, 0.47942E+00, 0.48213E+00, 0.48484E+00, 0.48754E+00, + & 0.49023E+00, 0.49292E+00, 0.49561E+00, 0.49828E+00, 0.50095E+00, + & 0.50362E+00, 0.50627E+00, 0.50892E+00, 0.51157E+00, 0.51421E+00, + & 0.51684E+00, 0.51947E+00, 0.52209E+00, 0.52470E+00, 0.52731E+00, + & 0.52991E+00, 0.53251E+00, 0.53510E+00, 0.53769E+00, 0.54027E+00, + & 0.54284E+00, 0.54541E+00, 0.54797E+00, 0.55052E+00, 0.55307E+00/ + + DATA (BNC09M (I),I=301,400)/ + & 0.55562E+00, 0.55816E+00, 0.56069E+00, 0.56321E+00, 0.56574E+00, + & 0.56825E+00, 0.57076E+00, 0.57327E+00, 0.57576E+00, 0.57826E+00, + & 0.58075E+00, 0.58323E+00, 0.58570E+00, 0.58818E+00, 0.59064E+00, + & 0.59310E+00, 0.59556E+00, 0.59801E+00, 0.60045E+00, 0.60289E+00, + & 0.60532E+00, 0.60775E+00, 0.61017E+00, 0.61259E+00, 0.61500E+00, + & 0.61741E+00, 0.61981E+00, 0.62221E+00, 0.62460E+00, 0.62699E+00, + & 0.62937E+00, 0.63175E+00, 0.63412E+00, 0.63648E+00, 0.63885E+00, + & 0.64120E+00, 0.64355E+00, 0.64590E+00, 0.64824E+00, 0.65058E+00, + & 0.65291E+00, 0.65523E+00, 0.65755E+00, 0.65987E+00, 0.66218E+00, + & 0.66449E+00, 0.66679E+00, 0.66909E+00, 0.67138E+00, 0.67367E+00, + & 0.67595E+00, 0.67823E+00, 0.68050E+00, 0.68277E+00, 0.68503E+00, + & 0.68729E+00, 0.68955E+00, 0.69180E+00, 0.69404E+00, 0.69628E+00, + & 0.69852E+00, 0.70075E+00, 0.70298E+00, 0.70520E+00, 0.70742E+00, + & 0.70963E+00, 0.71184E+00, 0.71405E+00, 0.71625E+00, 0.71844E+00, + & 0.72063E+00, 0.72282E+00, 0.72500E+00, 0.72718E+00, 0.72935E+00, + & 0.73152E+00, 0.73369E+00, 0.73585E+00, 0.73800E+00, 0.74015E+00, + & 0.74230E+00, 0.74444E+00, 0.74658E+00, 0.74872E+00, 0.75085E+00, + & 0.75297E+00, 0.75510E+00, 0.75721E+00, 0.75933E+00, 0.76144E+00, + & 0.76354E+00, 0.76564E+00, 0.76774E+00, 0.76983E+00, 0.77192E+00, + & 0.77401E+00, 0.77609E+00, 0.77817E+00, 0.78024E+00, 0.78231E+00/ + + DATA (BNC09M (I),I=401,500)/ + & 0.78437E+00, 0.78643E+00, 0.78849E+00, 0.79054E+00, 0.79259E+00, + & 0.79464E+00, 0.79668E+00, 0.79871E+00, 0.80075E+00, 0.80278E+00, + & 0.80480E+00, 0.80682E+00, 0.80884E+00, 0.81085E+00, 0.81286E+00, + & 0.81487E+00, 0.81687E+00, 0.81887E+00, 0.82087E+00, 0.82286E+00, + & 0.82484E+00, 0.82683E+00, 0.82881E+00, 0.83078E+00, 0.83275E+00, + & 0.83472E+00, 0.83669E+00, 0.83865E+00, 0.84061E+00, 0.84256E+00, + & 0.84451E+00, 0.84646E+00, 0.84840E+00, 0.85034E+00, 0.85228E+00, + & 0.85421E+00, 0.85614E+00, 0.85806E+00, 0.85998E+00, 0.86190E+00, + & 0.86382E+00, 0.86573E+00, 0.86763E+00, 0.86954E+00, 0.87144E+00, + & 0.87333E+00, 0.87523E+00, 0.87712E+00, 0.87900E+00, 0.88089E+00, + & 0.88277E+00, 0.88464E+00, 0.88652E+00, 0.88839E+00, 0.89025E+00, + & 0.89212E+00, 0.89397E+00, 0.89583E+00, 0.89768E+00, 0.89953E+00, + & 0.90138E+00, 0.90322E+00, 0.90506E+00, 0.90690E+00, 0.90873E+00, + & 0.91056E+00, 0.91239E+00, 0.91421E+00, 0.91603E+00, 0.91784E+00, + & 0.91966E+00, 0.92147E+00, 0.92327E+00, 0.92508E+00, 0.92688E+00, + & 0.92868E+00, 0.93047E+00, 0.93226E+00, 0.93405E+00, 0.93583E+00, + & 0.93761E+00, 0.93939E+00, 0.94117E+00, 0.94294E+00, 0.94471E+00, + & 0.94648E+00, 0.94824E+00, 0.95000E+00, 0.95175E+00, 0.95351E+00, + & 0.95526E+00, 0.95701E+00, 0.95875E+00, 0.96049E+00, 0.96223E+00, + & 0.96397E+00, 0.96570E+00, 0.96743E+00, 0.96915E+00, 0.97088E+00/ + + DATA (BNC09M (I),I=501,600)/ + & 0.97260E+00, 0.97432E+00, 0.97603E+00, 0.97774E+00, 0.97945E+00, + & 0.98116E+00, 0.98286E+00, 0.98456E+00, 0.98626E+00, 0.98795E+00, + & 0.98964E+00, 0.99133E+00, 0.99302E+00, 0.99470E+00, 0.99638E+00, + & 0.99806E+00, 0.99973E+00, 0.10014E+01, 0.10031E+01, 0.10047E+01, + & 0.10064E+01, 0.10081E+01, 0.10097E+01, 0.10114E+01, 0.10130E+01, + & 0.10147E+01, 0.10163E+01, 0.10180E+01, 0.10196E+01, 0.10212E+01, + & 0.10229E+01, 0.10245E+01, 0.10261E+01, 0.10278E+01, 0.10294E+01, + & 0.10310E+01, 0.10326E+01, 0.10342E+01, 0.10359E+01, 0.10375E+01, + & 0.10391E+01, 0.10407E+01, 0.10423E+01, 0.10439E+01, 0.10455E+01, + & 0.10471E+01, 0.10487E+01, 0.10503E+01, 0.10519E+01, 0.10534E+01, + & 0.10550E+01, 0.10566E+01, 0.10582E+01, 0.10598E+01, 0.10613E+01, + & 0.10629E+01, 0.10645E+01, 0.10660E+01, 0.10676E+01, 0.10691E+01, + & 0.10707E+01, 0.10723E+01, 0.10738E+01, 0.10754E+01, 0.10769E+01, + & 0.10784E+01, 0.10800E+01, 0.10815E+01, 0.10831E+01, 0.10846E+01, + & 0.10861E+01, 0.10877E+01, 0.10892E+01, 0.10907E+01, 0.10922E+01, + & 0.10938E+01, 0.10953E+01, 0.10968E+01, 0.10983E+01, 0.10998E+01, + & 0.11013E+01, 0.11028E+01, 0.11043E+01, 0.11058E+01, 0.11073E+01, + & 0.11088E+01, 0.11103E+01, 0.11118E+01, 0.11133E+01, 0.11148E+01, + & 0.11163E+01, 0.11177E+01, 0.11192E+01, 0.11207E+01, 0.11222E+01, + & 0.11236E+01, 0.11251E+01, 0.11266E+01, 0.11280E+01, 0.11335E+01/ + + DATA (BNC09M (I),I=601,700)/ + & 0.11454E+01, 0.11597E+01, 0.11737E+01, 0.11876E+01, 0.12012E+01, + & 0.12146E+01, 0.12278E+01, 0.12409E+01, 0.12537E+01, 0.12663E+01, + & 0.12788E+01, 0.12911E+01, 0.13032E+01, 0.13152E+01, 0.13270E+01, + & 0.13386E+01, 0.13500E+01, 0.13613E+01, 0.13725E+01, 0.13835E+01, + & 0.13943E+01, 0.14050E+01, 0.14156E+01, 0.14260E+01, 0.14363E+01, + & 0.14464E+01, 0.14564E+01, 0.14663E+01, 0.14761E+01, 0.14857E+01, + & 0.14952E+01, 0.15046E+01, 0.15139E+01, 0.15231E+01, 0.15321E+01, + & 0.15410E+01, 0.15499E+01, 0.15586E+01, 0.15672E+01, 0.15757E+01, + & 0.15841E+01, 0.15923E+01, 0.16005E+01, 0.16086E+01, 0.16166E+01, + & 0.16245E+01, 0.16323E+01, 0.16400E+01, 0.16477E+01, 0.16552E+01, + & 0.16626E+01, 0.16700E+01, 0.16773E+01, 0.16845E+01, 0.16916E+01, + & 0.16986E+01, 0.17055E+01, 0.17124E+01, 0.17192E+01, 0.17259E+01, + & 0.17325E+01, 0.17390E+01, 0.17455E+01, 0.17519E+01, 0.17583E+01, + & 0.17645E+01, 0.17707E+01, 0.17768E+01, 0.17829E+01, 0.17889E+01, + & 0.17948E+01, 0.18006E+01, 0.18064E+01, 0.18121E+01, 0.18178E+01, + & 0.18234E+01, 0.18289E+01, 0.18344E+01, 0.18398E+01, 0.18452E+01, + & 0.18505E+01, 0.18557E+01, 0.18609E+01, 0.18660E+01, 0.18711E+01, + & 0.18761E+01, 0.18811E+01, 0.18860E+01, 0.18908E+01, 0.18956E+01, + & 0.19004E+01, 0.19050E+01, 0.19097E+01, 0.19143E+01, 0.19188E+01, + & 0.19233E+01, 0.19278E+01, 0.19322E+01, 0.19365E+01, 0.19408E+01/ + + DATA (BNC09M(I),I=701,741)/ + & 0.19451E+01, 0.19493E+01, 0.19535E+01, 0.19576E+01, 0.19616E+01, + & 0.19657E+01, 0.19697E+01, 0.19736E+01, 0.19775E+01, 0.19814E+01, + & 0.19852E+01, 0.19890E+01, 0.19927E+01, 0.19964E+01, 0.20001E+01, + & 0.20037E+01, 0.20073E+01, 0.20108E+01, 0.20143E+01, 0.20178E+01, + & 0.20212E+01, 0.20246E+01, 0.20279E+01, 0.20312E+01, 0.20345E+01, + & 0.20378E+01, 0.20410E+01, 0.20441E+01, 0.20473E+01, 0.20504E+01, + & 0.20534E+01, 0.20565E+01, 0.20595E+01, 0.20624E+01, 0.20654E+01, + & 0.20683E+01, 0.20711E+01, 0.20740E+01, 0.20768E+01, 0.20796E+01, + & 0.20823E+01 + & / +C +C *** (H, NO3) +C + DATA (BNC10M (I),I= 1,100)/ + &-0.53284E-01,-0.93378E-01,-0.11890E+00,-0.13461E+00,-0.14557E+00, + &-0.15369E+00,-0.15987E+00,-0.16466E+00,-0.16839E+00,-0.17129E+00, + &-0.17352E+00,-0.17519E+00,-0.17640E+00,-0.17722E+00,-0.17770E+00, + &-0.17789E+00,-0.17782E+00,-0.17753E+00,-0.17704E+00,-0.17638E+00, + &-0.17556E+00,-0.17459E+00,-0.17350E+00,-0.17230E+00,-0.17099E+00, + &-0.16959E+00,-0.16811E+00,-0.16655E+00,-0.16492E+00,-0.16323E+00, + &-0.16149E+00,-0.15969E+00,-0.15785E+00,-0.15596E+00,-0.15404E+00, + &-0.15208E+00,-0.15010E+00,-0.14808E+00,-0.14604E+00,-0.14398E+00, + &-0.14191E+00,-0.13981E+00,-0.13770E+00,-0.13557E+00,-0.13344E+00, + &-0.13129E+00,-0.12914E+00,-0.12698E+00,-0.12481E+00,-0.12264E+00, + &-0.12046E+00,-0.11828E+00,-0.11609E+00,-0.11390E+00,-0.11171E+00, + &-0.10952E+00,-0.10732E+00,-0.10512E+00,-0.10292E+00,-0.10071E+00, + &-0.98502E-01,-0.96290E-01,-0.94074E-01,-0.91854E-01,-0.89629E-01, + &-0.87399E-01,-0.85162E-01,-0.82919E-01,-0.80669E-01,-0.78411E-01, + &-0.76144E-01,-0.73868E-01,-0.71581E-01,-0.69284E-01,-0.66975E-01, + &-0.64655E-01,-0.62321E-01,-0.59973E-01,-0.57612E-01,-0.55236E-01, + &-0.52844E-01,-0.50437E-01,-0.48014E-01,-0.45574E-01,-0.43117E-01, + &-0.40643E-01,-0.38151E-01,-0.35641E-01,-0.33114E-01,-0.30569E-01, + &-0.28006E-01,-0.25426E-01,-0.22827E-01,-0.20212E-01,-0.17578E-01, + &-0.14928E-01,-0.12262E-01,-0.95788E-02,-0.68800E-02,-0.41657E-02/ + + DATA (BNC10M (I),I=101,200)/ + &-0.14365E-02, 0.13072E-02, 0.40646E-02, 0.68354E-02, 0.96189E-02, + & 0.12415E-01, 0.15222E-01, 0.18040E-01, 0.20868E-01, 0.23706E-01, + & 0.26553E-01, 0.29408E-01, 0.32271E-01, 0.35141E-01, 0.38017E-01, + & 0.40900E-01, 0.43787E-01, 0.46680E-01, 0.49577E-01, 0.52478E-01, + & 0.55030E-01, 0.57977E-01, 0.60923E-01, 0.63866E-01, 0.66808E-01, + & 0.69748E-01, 0.72686E-01, 0.75621E-01, 0.78554E-01, 0.81485E-01, + & 0.84414E-01, 0.87340E-01, 0.90263E-01, 0.93184E-01, 0.96103E-01, + & 0.99018E-01, 0.10193E+00, 0.10484E+00, 0.10775E+00, 0.11065E+00, + & 0.11355E+00, 0.11645E+00, 0.11934E+00, 0.12224E+00, 0.12512E+00, + & 0.12801E+00, 0.13089E+00, 0.13377E+00, 0.13664E+00, 0.13951E+00, + & 0.14238E+00, 0.14525E+00, 0.14811E+00, 0.15097E+00, 0.15382E+00, + & 0.15667E+00, 0.15951E+00, 0.16236E+00, 0.16520E+00, 0.16803E+00, + & 0.17086E+00, 0.17369E+00, 0.17651E+00, 0.17933E+00, 0.18215E+00, + & 0.18496E+00, 0.18776E+00, 0.19057E+00, 0.19337E+00, 0.19616E+00, + & 0.19895E+00, 0.20174E+00, 0.20452E+00, 0.20730E+00, 0.21008E+00, + & 0.21285E+00, 0.21561E+00, 0.21837E+00, 0.22113E+00, 0.22389E+00, + & 0.22663E+00, 0.22938E+00, 0.23212E+00, 0.23486E+00, 0.23759E+00, + & 0.24032E+00, 0.24304E+00, 0.24576E+00, 0.24847E+00, 0.25118E+00, + & 0.25389E+00, 0.25659E+00, 0.25929E+00, 0.26198E+00, 0.26467E+00, + & 0.26735E+00, 0.27003E+00, 0.27270E+00, 0.27537E+00, 0.27804E+00/ + + DATA (BNC10M (I),I=201,300)/ + & 0.28070E+00, 0.28336E+00, 0.28601E+00, 0.28866E+00, 0.29130E+00, + & 0.29394E+00, 0.29657E+00, 0.29920E+00, 0.30183E+00, 0.30445E+00, + & 0.30707E+00, 0.30968E+00, 0.31229E+00, 0.31489E+00, 0.31749E+00, + & 0.32008E+00, 0.32267E+00, 0.32525E+00, 0.32783E+00, 0.33041E+00, + & 0.33298E+00, 0.33555E+00, 0.33811E+00, 0.34067E+00, 0.34322E+00, + & 0.34577E+00, 0.34831E+00, 0.35085E+00, 0.35339E+00, 0.35592E+00, + & 0.35844E+00, 0.36097E+00, 0.36348E+00, 0.36599E+00, 0.36850E+00, + & 0.37101E+00, 0.37351E+00, 0.37600E+00, 0.37849E+00, 0.38098E+00, + & 0.38346E+00, 0.38593E+00, 0.38840E+00, 0.39087E+00, 0.39334E+00, + & 0.39579E+00, 0.39825E+00, 0.40070E+00, 0.40314E+00, 0.40558E+00, + & 0.40802E+00, 0.41045E+00, 0.41288E+00, 0.41530E+00, 0.41772E+00, + & 0.42014E+00, 0.42255E+00, 0.42495E+00, 0.42735E+00, 0.42975E+00, + & 0.43214E+00, 0.43453E+00, 0.43691E+00, 0.43929E+00, 0.44167E+00, + & 0.44404E+00, 0.44640E+00, 0.44877E+00, 0.45112E+00, 0.45348E+00, + & 0.45583E+00, 0.45817E+00, 0.46051E+00, 0.46285E+00, 0.46518E+00, + & 0.46751E+00, 0.46983E+00, 0.47215E+00, 0.47446E+00, 0.47677E+00, + & 0.47908E+00, 0.48138E+00, 0.48368E+00, 0.48597E+00, 0.48826E+00, + & 0.49054E+00, 0.49283E+00, 0.49510E+00, 0.49737E+00, 0.49964E+00, + & 0.50191E+00, 0.50417E+00, 0.50642E+00, 0.50867E+00, 0.51092E+00, + & 0.51316E+00, 0.51540E+00, 0.51764E+00, 0.51987E+00, 0.52210E+00/ + + DATA (BNC10M (I),I=301,400)/ + & 0.52432E+00, 0.52654E+00, 0.52875E+00, 0.53096E+00, 0.53317E+00, + & 0.53537E+00, 0.53757E+00, 0.53976E+00, 0.54195E+00, 0.54414E+00, + & 0.54632E+00, 0.54850E+00, 0.55067E+00, 0.55284E+00, 0.55501E+00, + & 0.55717E+00, 0.55933E+00, 0.56148E+00, 0.56363E+00, 0.56578E+00, + & 0.56792E+00, 0.57006E+00, 0.57219E+00, 0.57433E+00, 0.57645E+00, + & 0.57857E+00, 0.58069E+00, 0.58281E+00, 0.58492E+00, 0.58703E+00, + & 0.58913E+00, 0.59123E+00, 0.59333E+00, 0.59542E+00, 0.59751E+00, + & 0.59959E+00, 0.60167E+00, 0.60375E+00, 0.60582E+00, 0.60789E+00, + & 0.60996E+00, 0.61202E+00, 0.61407E+00, 0.61613E+00, 0.61818E+00, + & 0.62023E+00, 0.62227E+00, 0.62431E+00, 0.62634E+00, 0.62838E+00, + & 0.63040E+00, 0.63243E+00, 0.63445E+00, 0.63647E+00, 0.63848E+00, + & 0.64049E+00, 0.64250E+00, 0.64450E+00, 0.64650E+00, 0.64849E+00, + & 0.65049E+00, 0.65247E+00, 0.65446E+00, 0.65644E+00, 0.65842E+00, + & 0.66039E+00, 0.66236E+00, 0.66433E+00, 0.66629E+00, 0.66825E+00, + & 0.67021E+00, 0.67216E+00, 0.67411E+00, 0.67606E+00, 0.67800E+00, + & 0.67994E+00, 0.68187E+00, 0.68380E+00, 0.68573E+00, 0.68766E+00, + & 0.68958E+00, 0.69150E+00, 0.69341E+00, 0.69532E+00, 0.69723E+00, + & 0.69914E+00, 0.70104E+00, 0.70294E+00, 0.70483E+00, 0.70672E+00, + & 0.70861E+00, 0.71049E+00, 0.71237E+00, 0.71425E+00, 0.71613E+00, + & 0.71800E+00, 0.71986E+00, 0.72173E+00, 0.72359E+00, 0.72545E+00/ + + DATA (BNC10M (I),I=401,500)/ + & 0.72730E+00, 0.72915E+00, 0.73100E+00, 0.73285E+00, 0.73469E+00, + & 0.73653E+00, 0.73836E+00, 0.74019E+00, 0.74202E+00, 0.74385E+00, + & 0.74567E+00, 0.74749E+00, 0.74930E+00, 0.75112E+00, 0.75293E+00, + & 0.75473E+00, 0.75654E+00, 0.75834E+00, 0.76013E+00, 0.76193E+00, + & 0.76372E+00, 0.76550E+00, 0.76729E+00, 0.76907E+00, 0.77085E+00, + & 0.77262E+00, 0.77439E+00, 0.77616E+00, 0.77793E+00, 0.77969E+00, + & 0.78145E+00, 0.78321E+00, 0.78496E+00, 0.78671E+00, 0.78846E+00, + & 0.79021E+00, 0.79195E+00, 0.79369E+00, 0.79542E+00, 0.79715E+00, + & 0.79888E+00, 0.80061E+00, 0.80233E+00, 0.80405E+00, 0.80577E+00, + & 0.80749E+00, 0.80920E+00, 0.81091E+00, 0.81261E+00, 0.81432E+00, + & 0.81602E+00, 0.81771E+00, 0.81941E+00, 0.82110E+00, 0.82279E+00, + & 0.82448E+00, 0.82616E+00, 0.82784E+00, 0.82952E+00, 0.83119E+00, + & 0.83286E+00, 0.83453E+00, 0.83620E+00, 0.83786E+00, 0.83952E+00, + & 0.84118E+00, 0.84283E+00, 0.84448E+00, 0.84613E+00, 0.84778E+00, + & 0.84942E+00, 0.85106E+00, 0.85270E+00, 0.85434E+00, 0.85597E+00, + & 0.85760E+00, 0.85922E+00, 0.86085E+00, 0.86247E+00, 0.86409E+00, + & 0.86571E+00, 0.86732E+00, 0.86893E+00, 0.87054E+00, 0.87214E+00, + & 0.87375E+00, 0.87535E+00, 0.87694E+00, 0.87854E+00, 0.88013E+00, + & 0.88172E+00, 0.88331E+00, 0.88489E+00, 0.88647E+00, 0.88805E+00, + & 0.88963E+00, 0.89120E+00, 0.89277E+00, 0.89434E+00, 0.89590E+00/ + + DATA (BNC10M (I),I=501,600)/ + & 0.89747E+00, 0.89903E+00, 0.90059E+00, 0.90214E+00, 0.90369E+00, + & 0.90524E+00, 0.90679E+00, 0.90834E+00, 0.90988E+00, 0.91142E+00, + & 0.91296E+00, 0.91449E+00, 0.91603E+00, 0.91756E+00, 0.91908E+00, + & 0.92061E+00, 0.92213E+00, 0.92365E+00, 0.92517E+00, 0.92668E+00, + & 0.92820E+00, 0.92971E+00, 0.93122E+00, 0.93272E+00, 0.93422E+00, + & 0.93572E+00, 0.93722E+00, 0.93872E+00, 0.94021E+00, 0.94170E+00, + & 0.94319E+00, 0.94468E+00, 0.94616E+00, 0.94764E+00, 0.94912E+00, + & 0.95060E+00, 0.95207E+00, 0.95354E+00, 0.95501E+00, 0.95648E+00, + & 0.95794E+00, 0.95940E+00, 0.96086E+00, 0.96232E+00, 0.96378E+00, + & 0.96523E+00, 0.96668E+00, 0.96813E+00, 0.96957E+00, 0.97102E+00, + & 0.97246E+00, 0.97390E+00, 0.97533E+00, 0.97677E+00, 0.97820E+00, + & 0.97963E+00, 0.98106E+00, 0.98248E+00, 0.98391E+00, 0.98533E+00, + & 0.98674E+00, 0.98816E+00, 0.98957E+00, 0.99099E+00, 0.99240E+00, + & 0.99380E+00, 0.99521E+00, 0.99661E+00, 0.99801E+00, 0.99941E+00, + & 0.10008E+01, 0.10022E+01, 0.10036E+01, 0.10050E+01, 0.10064E+01, + & 0.10078E+01, 0.10091E+01, 0.10105E+01, 0.10119E+01, 0.10133E+01, + & 0.10146E+01, 0.10160E+01, 0.10174E+01, 0.10188E+01, 0.10201E+01, + & 0.10215E+01, 0.10228E+01, 0.10242E+01, 0.10256E+01, 0.10269E+01, + & 0.10283E+01, 0.10296E+01, 0.10310E+01, 0.10323E+01, 0.10337E+01, + & 0.10350E+01, 0.10363E+01, 0.10377E+01, 0.10390E+01, 0.10440E+01/ + + DATA (BNC10M (I),I=601,700)/ + & 0.10549E+01, 0.10679E+01, 0.10807E+01, 0.10933E+01, 0.11058E+01, + & 0.11180E+01, 0.11301E+01, 0.11420E+01, 0.11537E+01, 0.11652E+01, + & 0.11766E+01, 0.11878E+01, 0.11989E+01, 0.12098E+01, 0.12205E+01, + & 0.12311E+01, 0.12415E+01, 0.12518E+01, 0.12620E+01, 0.12720E+01, + & 0.12819E+01, 0.12916E+01, 0.13012E+01, 0.13107E+01, 0.13201E+01, + & 0.13293E+01, 0.13384E+01, 0.13474E+01, 0.13562E+01, 0.13650E+01, + & 0.13736E+01, 0.13821E+01, 0.13905E+01, 0.13988E+01, 0.14070E+01, + & 0.14151E+01, 0.14231E+01, 0.14310E+01, 0.14388E+01, 0.14464E+01, + & 0.14540E+01, 0.14615E+01, 0.14689E+01, 0.14762E+01, 0.14834E+01, + & 0.14906E+01, 0.14976E+01, 0.15045E+01, 0.15114E+01, 0.15182E+01, + & 0.15249E+01, 0.15315E+01, 0.15380E+01, 0.15444E+01, 0.15508E+01, + & 0.15571E+01, 0.15633E+01, 0.15695E+01, 0.15755E+01, 0.15815E+01, + & 0.15875E+01, 0.15933E+01, 0.15991E+01, 0.16048E+01, 0.16105E+01, + & 0.16160E+01, 0.16215E+01, 0.16270E+01, 0.16324E+01, 0.16377E+01, + & 0.16429E+01, 0.16481E+01, 0.16533E+01, 0.16583E+01, 0.16634E+01, + & 0.16683E+01, 0.16732E+01, 0.16780E+01, 0.16828E+01, 0.16875E+01, + & 0.16922E+01, 0.16968E+01, 0.17014E+01, 0.17059E+01, 0.17104E+01, + & 0.17148E+01, 0.17191E+01, 0.17234E+01, 0.17277E+01, 0.17319E+01, + & 0.17360E+01, 0.17401E+01, 0.17442E+01, 0.17482E+01, 0.17521E+01, + & 0.17560E+01, 0.17599E+01, 0.17637E+01, 0.17675E+01, 0.17712E+01/ + + DATA (BNC10M(I),I=701,741)/ + & 0.17749E+01, 0.17786E+01, 0.17822E+01, 0.17858E+01, 0.17893E+01, + & 0.17927E+01, 0.17962E+01, 0.17996E+01, 0.18029E+01, 0.18063E+01, + & 0.18095E+01, 0.18128E+01, 0.18160E+01, 0.18191E+01, 0.18223E+01, + & 0.18253E+01, 0.18284E+01, 0.18314E+01, 0.18344E+01, 0.18373E+01, + & 0.18402E+01, 0.18431E+01, 0.18459E+01, 0.18487E+01, 0.18515E+01, + & 0.18542E+01, 0.18569E+01, 0.18596E+01, 0.18623E+01, 0.18649E+01, + & 0.18674E+01, 0.18700E+01, 0.18725E+01, 0.18749E+01, 0.18774E+01, + & 0.18798E+01, 0.18822E+01, 0.18845E+01, 0.18869E+01, 0.18892E+01, + & 0.18914E+01 + & / +C +C *** (H, Cl) +C + DATA (BNC11M (I),I= 1,100)/ + &-0.51530E-01,-0.87364E-01,-0.10805E+00,-0.11938E+00,-0.12621E+00, + &-0.13034E+00,-0.13263E+00,-0.13358E+00,-0.13351E+00,-0.13262E+00, + &-0.13105E+00,-0.12892E+00,-0.12631E+00,-0.12328E+00,-0.11989E+00, + &-0.11617E+00,-0.11216E+00,-0.10789E+00,-0.10338E+00,-0.98657E-01, + &-0.93734E-01,-0.88627E-01,-0.83353E-01,-0.77922E-01,-0.72347E-01, + &-0.66638E-01,-0.60804E-01,-0.54854E-01,-0.48795E-01,-0.42636E-01, + &-0.36382E-01,-0.30040E-01,-0.23617E-01,-0.17116E-01,-0.10545E-01, + &-0.39064E-02, 0.27939E-02, 0.95516E-02, 0.16363E-01, 0.23224E-01, + & 0.30132E-01, 0.37082E-01, 0.44072E-01, 0.51099E-01, 0.58160E-01, + & 0.65253E-01, 0.72375E-01, 0.79524E-01, 0.86699E-01, 0.93897E-01, + & 0.10112E+00, 0.10836E+00, 0.11562E+00, 0.12290E+00, 0.13019E+00, + & 0.13750E+00, 0.14483E+00, 0.15218E+00, 0.15954E+00, 0.16691E+00, + & 0.17430E+00, 0.18171E+00, 0.18913E+00, 0.19657E+00, 0.20403E+00, + & 0.21151E+00, 0.21900E+00, 0.22652E+00, 0.23405E+00, 0.24161E+00, + & 0.24919E+00, 0.25680E+00, 0.26443E+00, 0.27209E+00, 0.27977E+00, + & 0.28749E+00, 0.29523E+00, 0.30301E+00, 0.31082E+00, 0.31867E+00, + & 0.32655E+00, 0.33446E+00, 0.34241E+00, 0.35040E+00, 0.35843E+00, + & 0.36650E+00, 0.37461E+00, 0.38275E+00, 0.39094E+00, 0.39916E+00, + & 0.40743E+00, 0.41574E+00, 0.42408E+00, 0.43246E+00, 0.44088E+00, + & 0.44934E+00, 0.45784E+00, 0.46637E+00, 0.47494E+00, 0.48354E+00/ + + DATA (BNC11M (I),I=101,200)/ + & 0.49217E+00, 0.50083E+00, 0.50952E+00, 0.51825E+00, 0.52699E+00, + & 0.53577E+00, 0.54456E+00, 0.55338E+00, 0.56222E+00, 0.57108E+00, + & 0.57996E+00, 0.58885E+00, 0.59776E+00, 0.60668E+00, 0.61561E+00, + & 0.62456E+00, 0.63351E+00, 0.64246E+00, 0.65143E+00, 0.66039E+00, + & 0.66855E+00, 0.67762E+00, 0.68668E+00, 0.69573E+00, 0.70477E+00, + & 0.71380E+00, 0.72282E+00, 0.73183E+00, 0.74082E+00, 0.74981E+00, + & 0.75879E+00, 0.76776E+00, 0.77671E+00, 0.78566E+00, 0.79459E+00, + & 0.80351E+00, 0.81241E+00, 0.82131E+00, 0.83019E+00, 0.83906E+00, + & 0.84792E+00, 0.85676E+00, 0.86559E+00, 0.87440E+00, 0.88321E+00, + & 0.89200E+00, 0.90077E+00, 0.90953E+00, 0.91827E+00, 0.92701E+00, + & 0.93572E+00, 0.94443E+00, 0.95311E+00, 0.96178E+00, 0.97044E+00, + & 0.97908E+00, 0.98771E+00, 0.99632E+00, 0.10049E+01, 0.10135E+01, + & 0.10221E+01, 0.10306E+01, 0.10392E+01, 0.10477E+01, 0.10562E+01, + & 0.10647E+01, 0.10731E+01, 0.10816E+01, 0.10900E+01, 0.10984E+01, + & 0.11069E+01, 0.11152E+01, 0.11236E+01, 0.11320E+01, 0.11403E+01, + & 0.11486E+01, 0.11570E+01, 0.11652E+01, 0.11735E+01, 0.11818E+01, + & 0.11900E+01, 0.11983E+01, 0.12065E+01, 0.12147E+01, 0.12228E+01, + & 0.12310E+01, 0.12391E+01, 0.12473E+01, 0.12554E+01, 0.12635E+01, + & 0.12716E+01, 0.12796E+01, 0.12877E+01, 0.12957E+01, 0.13037E+01, + & 0.13117E+01, 0.13197E+01, 0.13276E+01, 0.13356E+01, 0.13435E+01/ + + DATA (BNC11M (I),I=201,300)/ + & 0.13514E+01, 0.13593E+01, 0.13672E+01, 0.13751E+01, 0.13829E+01, + & 0.13908E+01, 0.13986E+01, 0.14064E+01, 0.14142E+01, 0.14219E+01, + & 0.14297E+01, 0.14374E+01, 0.14451E+01, 0.14528E+01, 0.14605E+01, + & 0.14682E+01, 0.14758E+01, 0.14835E+01, 0.14911E+01, 0.14987E+01, + & 0.15063E+01, 0.15139E+01, 0.15214E+01, 0.15289E+01, 0.15365E+01, + & 0.15440E+01, 0.15515E+01, 0.15590E+01, 0.15664E+01, 0.15739E+01, + & 0.15813E+01, 0.15887E+01, 0.15961E+01, 0.16035E+01, 0.16109E+01, + & 0.16182E+01, 0.16255E+01, 0.16329E+01, 0.16402E+01, 0.16475E+01, + & 0.16547E+01, 0.16620E+01, 0.16692E+01, 0.16765E+01, 0.16837E+01, + & 0.16909E+01, 0.16981E+01, 0.17052E+01, 0.17124E+01, 0.17195E+01, + & 0.17266E+01, 0.17338E+01, 0.17408E+01, 0.17479E+01, 0.17550E+01, + & 0.17620E+01, 0.17691E+01, 0.17761E+01, 0.17831E+01, 0.17901E+01, + & 0.17971E+01, 0.18040E+01, 0.18110E+01, 0.18179E+01, 0.18248E+01, + & 0.18317E+01, 0.18386E+01, 0.18455E+01, 0.18524E+01, 0.18592E+01, + & 0.18660E+01, 0.18729E+01, 0.18797E+01, 0.18865E+01, 0.18932E+01, + & 0.19000E+01, 0.19068E+01, 0.19135E+01, 0.19202E+01, 0.19269E+01, + & 0.19336E+01, 0.19403E+01, 0.19470E+01, 0.19536E+01, 0.19603E+01, + & 0.19669E+01, 0.19735E+01, 0.19801E+01, 0.19867E+01, 0.19933E+01, + & 0.19998E+01, 0.20064E+01, 0.20129E+01, 0.20194E+01, 0.20259E+01, + & 0.20324E+01, 0.20389E+01, 0.20454E+01, 0.20518E+01, 0.20583E+01/ + + DATA (BNC11M (I),I=301,400)/ + & 0.20647E+01, 0.20711E+01, 0.20775E+01, 0.20839E+01, 0.20903E+01, + & 0.20967E+01, 0.21030E+01, 0.21093E+01, 0.21157E+01, 0.21220E+01, + & 0.21283E+01, 0.21346E+01, 0.21409E+01, 0.21471E+01, 0.21534E+01, + & 0.21596E+01, 0.21659E+01, 0.21721E+01, 0.21783E+01, 0.21845E+01, + & 0.21907E+01, 0.21968E+01, 0.22030E+01, 0.22091E+01, 0.22153E+01, + & 0.22214E+01, 0.22275E+01, 0.22336E+01, 0.22397E+01, 0.22457E+01, + & 0.22518E+01, 0.22579E+01, 0.22639E+01, 0.22699E+01, 0.22759E+01, + & 0.22819E+01, 0.22879E+01, 0.22939E+01, 0.22999E+01, 0.23058E+01, + & 0.23118E+01, 0.23177E+01, 0.23237E+01, 0.23296E+01, 0.23355E+01, + & 0.23414E+01, 0.23472E+01, 0.23531E+01, 0.23590E+01, 0.23648E+01, + & 0.23707E+01, 0.23765E+01, 0.23823E+01, 0.23881E+01, 0.23939E+01, + & 0.23997E+01, 0.24054E+01, 0.24112E+01, 0.24170E+01, 0.24227E+01, + & 0.24284E+01, 0.24341E+01, 0.24398E+01, 0.24455E+01, 0.24512E+01, + & 0.24569E+01, 0.24626E+01, 0.24682E+01, 0.24739E+01, 0.24795E+01, + & 0.24851E+01, 0.24907E+01, 0.24963E+01, 0.25019E+01, 0.25075E+01, + & 0.25131E+01, 0.25187E+01, 0.25242E+01, 0.25298E+01, 0.25353E+01, + & 0.25408E+01, 0.25463E+01, 0.25518E+01, 0.25573E+01, 0.25628E+01, + & 0.25683E+01, 0.25737E+01, 0.25792E+01, 0.25846E+01, 0.25901E+01, + & 0.25955E+01, 0.26009E+01, 0.26063E+01, 0.26117E+01, 0.26171E+01, + & 0.26225E+01, 0.26278E+01, 0.26332E+01, 0.26386E+01, 0.26439E+01/ + + DATA (BNC11M (I),I=401,500)/ + & 0.26492E+01, 0.26545E+01, 0.26599E+01, 0.26652E+01, 0.26704E+01, + & 0.26757E+01, 0.26810E+01, 0.26863E+01, 0.26915E+01, 0.26968E+01, + & 0.27020E+01, 0.27072E+01, 0.27125E+01, 0.27177E+01, 0.27229E+01, + & 0.27281E+01, 0.27332E+01, 0.27384E+01, 0.27436E+01, 0.27487E+01, + & 0.27539E+01, 0.27590E+01, 0.27642E+01, 0.27693E+01, 0.27744E+01, + & 0.27795E+01, 0.27846E+01, 0.27897E+01, 0.27948E+01, 0.27998E+01, + & 0.28049E+01, 0.28100E+01, 0.28150E+01, 0.28200E+01, 0.28251E+01, + & 0.28301E+01, 0.28351E+01, 0.28401E+01, 0.28451E+01, 0.28501E+01, + & 0.28551E+01, 0.28600E+01, 0.28650E+01, 0.28699E+01, 0.28749E+01, + & 0.28798E+01, 0.28847E+01, 0.28897E+01, 0.28946E+01, 0.28995E+01, + & 0.29044E+01, 0.29093E+01, 0.29141E+01, 0.29190E+01, 0.29239E+01, + & 0.29287E+01, 0.29336E+01, 0.29384E+01, 0.29433E+01, 0.29481E+01, + & 0.29529E+01, 0.29577E+01, 0.29625E+01, 0.29673E+01, 0.29721E+01, + & 0.29769E+01, 0.29816E+01, 0.29864E+01, 0.29911E+01, 0.29959E+01, + & 0.30006E+01, 0.30054E+01, 0.30101E+01, 0.30148E+01, 0.30195E+01, + & 0.30242E+01, 0.30289E+01, 0.30336E+01, 0.30383E+01, 0.30430E+01, + & 0.30476E+01, 0.30523E+01, 0.30569E+01, 0.30616E+01, 0.30662E+01, + & 0.30708E+01, 0.30754E+01, 0.30801E+01, 0.30847E+01, 0.30893E+01, + & 0.30939E+01, 0.30984E+01, 0.31030E+01, 0.31076E+01, 0.31122E+01, + & 0.31167E+01, 0.31213E+01, 0.31258E+01, 0.31303E+01, 0.31349E+01/ + + DATA (BNC11M (I),I=501,600)/ + & 0.31394E+01, 0.31439E+01, 0.31484E+01, 0.31529E+01, 0.31574E+01, + & 0.31619E+01, 0.31664E+01, 0.31708E+01, 0.31753E+01, 0.31798E+01, + & 0.31842E+01, 0.31887E+01, 0.31931E+01, 0.31975E+01, 0.32020E+01, + & 0.32064E+01, 0.32108E+01, 0.32152E+01, 0.32196E+01, 0.32240E+01, + & 0.32284E+01, 0.32327E+01, 0.32371E+01, 0.32415E+01, 0.32458E+01, + & 0.32502E+01, 0.32545E+01, 0.32589E+01, 0.32632E+01, 0.32675E+01, + & 0.32718E+01, 0.32762E+01, 0.32805E+01, 0.32848E+01, 0.32891E+01, + & 0.32934E+01, 0.32976E+01, 0.33019E+01, 0.33062E+01, 0.33104E+01, + & 0.33147E+01, 0.33189E+01, 0.33232E+01, 0.33274E+01, 0.33317E+01, + & 0.33359E+01, 0.33401E+01, 0.33443E+01, 0.33485E+01, 0.33527E+01, + & 0.33569E+01, 0.33611E+01, 0.33653E+01, 0.33695E+01, 0.33736E+01, + & 0.33778E+01, 0.33819E+01, 0.33861E+01, 0.33902E+01, 0.33944E+01, + & 0.33985E+01, 0.34026E+01, 0.34068E+01, 0.34109E+01, 0.34150E+01, + & 0.34191E+01, 0.34232E+01, 0.34273E+01, 0.34314E+01, 0.34355E+01, + & 0.34395E+01, 0.34436E+01, 0.34477E+01, 0.34517E+01, 0.34558E+01, + & 0.34598E+01, 0.34639E+01, 0.34679E+01, 0.34719E+01, 0.34759E+01, + & 0.34800E+01, 0.34840E+01, 0.34880E+01, 0.34920E+01, 0.34960E+01, + & 0.35000E+01, 0.35040E+01, 0.35079E+01, 0.35119E+01, 0.35159E+01, + & 0.35198E+01, 0.35238E+01, 0.35277E+01, 0.35317E+01, 0.35356E+01, + & 0.35396E+01, 0.35435E+01, 0.35474E+01, 0.35513E+01, 0.35660E+01/ + + DATA (BNC11M (I),I=601,700)/ + & 0.35979E+01, 0.36362E+01, 0.36739E+01, 0.37112E+01, 0.37479E+01, + & 0.37842E+01, 0.38200E+01, 0.38554E+01, 0.38903E+01, 0.39247E+01, + & 0.39588E+01, 0.39924E+01, 0.40256E+01, 0.40584E+01, 0.40909E+01, + & 0.41229E+01, 0.41546E+01, 0.41859E+01, 0.42168E+01, 0.42474E+01, + & 0.42776E+01, 0.43075E+01, 0.43371E+01, 0.43664E+01, 0.43953E+01, + & 0.44239E+01, 0.44522E+01, 0.44802E+01, 0.45079E+01, 0.45353E+01, + & 0.45624E+01, 0.45893E+01, 0.46158E+01, 0.46421E+01, 0.46681E+01, + & 0.46939E+01, 0.47194E+01, 0.47447E+01, 0.47697E+01, 0.47944E+01, + & 0.48190E+01, 0.48432E+01, 0.48673E+01, 0.48911E+01, 0.49147E+01, + & 0.49381E+01, 0.49612E+01, 0.49842E+01, 0.50069E+01, 0.50294E+01, + & 0.50517E+01, 0.50738E+01, 0.50958E+01, 0.51175E+01, 0.51390E+01, + & 0.51603E+01, 0.51815E+01, 0.52024E+01, 0.52232E+01, 0.52438E+01, + & 0.52643E+01, 0.52845E+01, 0.53046E+01, 0.53245E+01, 0.53442E+01, + & 0.53638E+01, 0.53832E+01, 0.54025E+01, 0.54216E+01, 0.54405E+01, + & 0.54593E+01, 0.54779E+01, 0.54964E+01, 0.55147E+01, 0.55329E+01, + & 0.55510E+01, 0.55689E+01, 0.55866E+01, 0.56043E+01, 0.56217E+01, + & 0.56391E+01, 0.56563E+01, 0.56734E+01, 0.56903E+01, 0.57072E+01, + & 0.57239E+01, 0.57404E+01, 0.57569E+01, 0.57732E+01, 0.57894E+01, + & 0.58055E+01, 0.58215E+01, 0.58373E+01, 0.58530E+01, 0.58687E+01, + & 0.58842E+01, 0.58996E+01, 0.59148E+01, 0.59300E+01, 0.59451E+01/ + + DATA (BNC11M(I),I=701,741)/ + & 0.59600E+01, 0.59749E+01, 0.59896E+01, 0.60043E+01, 0.60188E+01, + & 0.60333E+01, 0.60476E+01, 0.60619E+01, 0.60760E+01, 0.60901E+01, + & 0.61040E+01, 0.61179E+01, 0.61316E+01, 0.61453E+01, 0.61589E+01, + & 0.61724E+01, 0.61858E+01, 0.61991E+01, 0.62123E+01, 0.62254E+01, + & 0.62385E+01, 0.62514E+01, 0.62643E+01, 0.62771E+01, 0.62898E+01, + & 0.63024E+01, 0.63150E+01, 0.63274E+01, 0.63398E+01, 0.63521E+01, + & 0.63644E+01, 0.63765E+01, 0.63886E+01, 0.64006E+01, 0.64125E+01, + & 0.64243E+01, 0.64361E+01, 0.64478E+01, 0.64594E+01, 0.64710E+01, + & 0.64825E+01 + & / +C +C *** NaHSO4 +C + DATA (BNC12M (I),I= 1,100)/ + &-0.53059E-01,-0.92995E-01,-0.11872E+00,-0.13483E+00,-0.14630E+00, + &-0.15498E+00,-0.16174E+00,-0.16712E+00,-0.17143E+00,-0.17489E+00, + &-0.17765E+00,-0.17982E+00,-0.18150E+00,-0.18274E+00,-0.18359E+00, + &-0.18411E+00,-0.18432E+00,-0.18425E+00,-0.18392E+00,-0.18337E+00, + &-0.18259E+00,-0.18162E+00,-0.18045E+00,-0.17912E+00,-0.17761E+00, + &-0.17595E+00,-0.17414E+00,-0.17219E+00,-0.17011E+00,-0.16790E+00, + &-0.16557E+00,-0.16313E+00,-0.16057E+00,-0.15791E+00,-0.15515E+00, + &-0.15229E+00,-0.14934E+00,-0.14630E+00,-0.14318E+00,-0.13997E+00, + &-0.13669E+00,-0.13333E+00,-0.12990E+00,-0.12640E+00,-0.12284E+00, + &-0.11921E+00,-0.11552E+00,-0.11177E+00,-0.10796E+00,-0.10410E+00, + &-0.10019E+00,-0.96227E-01,-0.92215E-01,-0.88157E-01,-0.84053E-01, + &-0.79905E-01,-0.75715E-01,-0.71483E-01,-0.67210E-01,-0.62899E-01, + &-0.58548E-01,-0.54161E-01,-0.49736E-01,-0.45274E-01,-0.40777E-01, + &-0.36244E-01,-0.31676E-01,-0.27073E-01,-0.22436E-01,-0.17763E-01, + &-0.13056E-01,-0.83143E-02,-0.35376E-02, 0.12738E-02, 0.61202E-02, + & 0.11002E-01, 0.15919E-01, 0.20871E-01, 0.25859E-01, 0.30883E-01, + & 0.35942E-01, 0.41038E-01, 0.46170E-01, 0.51337E-01, 0.56541E-01, + & 0.61781E-01, 0.67057E-01, 0.72367E-01, 0.77714E-01, 0.83095E-01, + & 0.88511E-01, 0.93961E-01, 0.99444E-01, 0.10496E+00, 0.11051E+00, + & 0.11609E+00, 0.12170E+00, 0.12733E+00, 0.13300E+00, 0.13870E+00/ + + DATA (BNC12M (I),I=101,200)/ + & 0.14442E+00, 0.15016E+00, 0.15593E+00, 0.16173E+00, 0.16754E+00, + & 0.17337E+00, 0.17923E+00, 0.18510E+00, 0.19099E+00, 0.19689E+00, + & 0.20280E+00, 0.20873E+00, 0.21467E+00, 0.22062E+00, 0.22658E+00, + & 0.23255E+00, 0.23852E+00, 0.24450E+00, 0.25048E+00, 0.25647E+00, + & 0.26188E+00, 0.26794E+00, 0.27399E+00, 0.28003E+00, 0.28607E+00, + & 0.29209E+00, 0.29812E+00, 0.30413E+00, 0.31014E+00, 0.31613E+00, + & 0.32212E+00, 0.32811E+00, 0.33408E+00, 0.34004E+00, 0.34600E+00, + & 0.35194E+00, 0.35788E+00, 0.36380E+00, 0.36972E+00, 0.37562E+00, + & 0.38152E+00, 0.38740E+00, 0.39328E+00, 0.39914E+00, 0.40500E+00, + & 0.41084E+00, 0.41667E+00, 0.42249E+00, 0.42830E+00, 0.43410E+00, + & 0.43989E+00, 0.44567E+00, 0.45143E+00, 0.45719E+00, 0.46293E+00, + & 0.46866E+00, 0.47438E+00, 0.48008E+00, 0.48578E+00, 0.49146E+00, + & 0.49713E+00, 0.50279E+00, 0.50844E+00, 0.51408E+00, 0.51970E+00, + & 0.52531E+00, 0.53091E+00, 0.53650E+00, 0.54208E+00, 0.54764E+00, + & 0.55319E+00, 0.55873E+00, 0.56426E+00, 0.56978E+00, 0.57528E+00, + & 0.58077E+00, 0.58625E+00, 0.59172E+00, 0.59717E+00, 0.60261E+00, + & 0.60804E+00, 0.61346E+00, 0.61887E+00, 0.62426E+00, 0.62965E+00, + & 0.63502E+00, 0.64038E+00, 0.64572E+00, 0.65106E+00, 0.65638E+00, + & 0.66169E+00, 0.66699E+00, 0.67227E+00, 0.67755E+00, 0.68281E+00, + & 0.68806E+00, 0.69330E+00, 0.69853E+00, 0.70375E+00, 0.70895E+00/ + + DATA (BNC12M (I),I=201,300)/ + & 0.71414E+00, 0.71932E+00, 0.72449E+00, 0.72965E+00, 0.73479E+00, + & 0.73993E+00, 0.74505E+00, 0.75016E+00, 0.75526E+00, 0.76035E+00, + & 0.76543E+00, 0.77049E+00, 0.77554E+00, 0.78059E+00, 0.78562E+00, + & 0.79064E+00, 0.79565E+00, 0.80064E+00, 0.80563E+00, 0.81061E+00, + & 0.81557E+00, 0.82052E+00, 0.82547E+00, 0.83040E+00, 0.83532E+00, + & 0.84023E+00, 0.84512E+00, 0.85001E+00, 0.85489E+00, 0.85975E+00, + & 0.86461E+00, 0.86945E+00, 0.87429E+00, 0.87911E+00, 0.88392E+00, + & 0.88873E+00, 0.89352E+00, 0.89830E+00, 0.90307E+00, 0.90783E+00, + & 0.91258E+00, 0.91732E+00, 0.92205E+00, 0.92677E+00, 0.93148E+00, + & 0.93617E+00, 0.94086E+00, 0.94554E+00, 0.95021E+00, 0.95487E+00, + & 0.95951E+00, 0.96415E+00, 0.96878E+00, 0.97340E+00, 0.97801E+00, + & 0.98260E+00, 0.98719E+00, 0.99177E+00, 0.99634E+00, 0.10009E+01, + & 0.10054E+01, 0.10100E+01, 0.10145E+01, 0.10190E+01, 0.10235E+01, + & 0.10281E+01, 0.10325E+01, 0.10370E+01, 0.10415E+01, 0.10460E+01, + & 0.10504E+01, 0.10549E+01, 0.10593E+01, 0.10637E+01, 0.10681E+01, + & 0.10725E+01, 0.10769E+01, 0.10813E+01, 0.10857E+01, 0.10901E+01, + & 0.10945E+01, 0.10988E+01, 0.11031E+01, 0.11075E+01, 0.11118E+01, + & 0.11161E+01, 0.11204E+01, 0.11247E+01, 0.11290E+01, 0.11333E+01, + & 0.11376E+01, 0.11419E+01, 0.11461E+01, 0.11504E+01, 0.11546E+01, + & 0.11588E+01, 0.11631E+01, 0.11673E+01, 0.11715E+01, 0.11757E+01/ + + DATA (BNC12M (I),I=301,400)/ + & 0.11799E+01, 0.11840E+01, 0.11882E+01, 0.11924E+01, 0.11965E+01, + & 0.12007E+01, 0.12048E+01, 0.12089E+01, 0.12131E+01, 0.12172E+01, + & 0.12213E+01, 0.12254E+01, 0.12295E+01, 0.12336E+01, 0.12376E+01, + & 0.12417E+01, 0.12457E+01, 0.12498E+01, 0.12538E+01, 0.12579E+01, + & 0.12619E+01, 0.12659E+01, 0.12699E+01, 0.12739E+01, 0.12779E+01, + & 0.12819E+01, 0.12859E+01, 0.12899E+01, 0.12938E+01, 0.12978E+01, + & 0.13017E+01, 0.13057E+01, 0.13096E+01, 0.13135E+01, 0.13175E+01, + & 0.13214E+01, 0.13253E+01, 0.13292E+01, 0.13331E+01, 0.13369E+01, + & 0.13408E+01, 0.13447E+01, 0.13485E+01, 0.13524E+01, 0.13562E+01, + & 0.13601E+01, 0.13639E+01, 0.13677E+01, 0.13715E+01, 0.13754E+01, + & 0.13792E+01, 0.13829E+01, 0.13867E+01, 0.13905E+01, 0.13943E+01, + & 0.13981E+01, 0.14018E+01, 0.14056E+01, 0.14093E+01, 0.14131E+01, + & 0.14168E+01, 0.14205E+01, 0.14242E+01, 0.14279E+01, 0.14316E+01, + & 0.14353E+01, 0.14390E+01, 0.14427E+01, 0.14464E+01, 0.14501E+01, + & 0.14537E+01, 0.14574E+01, 0.14610E+01, 0.14647E+01, 0.14683E+01, + & 0.14720E+01, 0.14756E+01, 0.14792E+01, 0.14828E+01, 0.14864E+01, + & 0.14900E+01, 0.14936E+01, 0.14972E+01, 0.15008E+01, 0.15043E+01, + & 0.15079E+01, 0.15115E+01, 0.15150E+01, 0.15186E+01, 0.15221E+01, + & 0.15256E+01, 0.15292E+01, 0.15327E+01, 0.15362E+01, 0.15397E+01, + & 0.15432E+01, 0.15467E+01, 0.15502E+01, 0.15537E+01, 0.15572E+01/ + + DATA (BNC12M (I),I=401,500)/ + & 0.15607E+01, 0.15641E+01, 0.15676E+01, 0.15710E+01, 0.15745E+01, + & 0.15779E+01, 0.15814E+01, 0.15848E+01, 0.15882E+01, 0.15916E+01, + & 0.15951E+01, 0.15985E+01, 0.16019E+01, 0.16053E+01, 0.16087E+01, + & 0.16120E+01, 0.16154E+01, 0.16188E+01, 0.16222E+01, 0.16255E+01, + & 0.16289E+01, 0.16322E+01, 0.16356E+01, 0.16389E+01, 0.16422E+01, + & 0.16456E+01, 0.16489E+01, 0.16522E+01, 0.16555E+01, 0.16588E+01, + & 0.16621E+01, 0.16654E+01, 0.16687E+01, 0.16720E+01, 0.16753E+01, + & 0.16785E+01, 0.16818E+01, 0.16850E+01, 0.16883E+01, 0.16916E+01, + & 0.16948E+01, 0.16980E+01, 0.17013E+01, 0.17045E+01, 0.17077E+01, + & 0.17109E+01, 0.17142E+01, 0.17174E+01, 0.17206E+01, 0.17238E+01, + & 0.17269E+01, 0.17301E+01, 0.17333E+01, 0.17365E+01, 0.17397E+01, + & 0.17428E+01, 0.17460E+01, 0.17491E+01, 0.17523E+01, 0.17554E+01, + & 0.17586E+01, 0.17617E+01, 0.17648E+01, 0.17680E+01, 0.17711E+01, + & 0.17742E+01, 0.17773E+01, 0.17804E+01, 0.17835E+01, 0.17866E+01, + & 0.17897E+01, 0.17928E+01, 0.17958E+01, 0.17989E+01, 0.18020E+01, + & 0.18050E+01, 0.18081E+01, 0.18112E+01, 0.18142E+01, 0.18173E+01, + & 0.18203E+01, 0.18233E+01, 0.18264E+01, 0.18294E+01, 0.18324E+01, + & 0.18354E+01, 0.18384E+01, 0.18414E+01, 0.18444E+01, 0.18474E+01, + & 0.18504E+01, 0.18534E+01, 0.18564E+01, 0.18594E+01, 0.18623E+01, + & 0.18653E+01, 0.18683E+01, 0.18712E+01, 0.18742E+01, 0.18771E+01/ + + DATA (BNC12M (I),I=501,600)/ + & 0.18801E+01, 0.18830E+01, 0.18860E+01, 0.18889E+01, 0.18918E+01, + & 0.18947E+01, 0.18977E+01, 0.19006E+01, 0.19035E+01, 0.19064E+01, + & 0.19093E+01, 0.19122E+01, 0.19151E+01, 0.19180E+01, 0.19209E+01, + & 0.19237E+01, 0.19266E+01, 0.19295E+01, 0.19323E+01, 0.19352E+01, + & 0.19381E+01, 0.19409E+01, 0.19438E+01, 0.19466E+01, 0.19494E+01, + & 0.19523E+01, 0.19551E+01, 0.19579E+01, 0.19607E+01, 0.19636E+01, + & 0.19664E+01, 0.19692E+01, 0.19720E+01, 0.19748E+01, 0.19776E+01, + & 0.19804E+01, 0.19832E+01, 0.19860E+01, 0.19887E+01, 0.19915E+01, + & 0.19943E+01, 0.19970E+01, 0.19998E+01, 0.20026E+01, 0.20053E+01, + & 0.20081E+01, 0.20108E+01, 0.20136E+01, 0.20163E+01, 0.20190E+01, + & 0.20218E+01, 0.20245E+01, 0.20272E+01, 0.20299E+01, 0.20327E+01, + & 0.20354E+01, 0.20381E+01, 0.20408E+01, 0.20435E+01, 0.20462E+01, + & 0.20489E+01, 0.20515E+01, 0.20542E+01, 0.20569E+01, 0.20596E+01, + & 0.20622E+01, 0.20649E+01, 0.20676E+01, 0.20702E+01, 0.20729E+01, + & 0.20755E+01, 0.20782E+01, 0.20808E+01, 0.20835E+01, 0.20861E+01, + & 0.20887E+01, 0.20914E+01, 0.20940E+01, 0.20966E+01, 0.20992E+01, + & 0.21019E+01, 0.21045E+01, 0.21071E+01, 0.21097E+01, 0.21123E+01, + & 0.21149E+01, 0.21175E+01, 0.21200E+01, 0.21226E+01, 0.21252E+01, + & 0.21278E+01, 0.21304E+01, 0.21329E+01, 0.21355E+01, 0.21381E+01, + & 0.21406E+01, 0.21432E+01, 0.21457E+01, 0.21483E+01, 0.21578E+01/ + + DATA (BNC12M (I),I=601,700)/ + & 0.21786E+01, 0.22034E+01, 0.22280E+01, 0.22522E+01, 0.22760E+01, + & 0.22996E+01, 0.23228E+01, 0.23457E+01, 0.23684E+01, 0.23907E+01, + & 0.24128E+01, 0.24345E+01, 0.24560E+01, 0.24773E+01, 0.24982E+01, + & 0.25190E+01, 0.25394E+01, 0.25596E+01, 0.25796E+01, 0.25993E+01, + & 0.26188E+01, 0.26381E+01, 0.26571E+01, 0.26760E+01, 0.26946E+01, + & 0.27130E+01, 0.27312E+01, 0.27491E+01, 0.27669E+01, 0.27845E+01, + & 0.28019E+01, 0.28191E+01, 0.28361E+01, 0.28529E+01, 0.28696E+01, + & 0.28860E+01, 0.29023E+01, 0.29185E+01, 0.29344E+01, 0.29502E+01, + & 0.29658E+01, 0.29813E+01, 0.29966E+01, 0.30117E+01, 0.30267E+01, + & 0.30415E+01, 0.30562E+01, 0.30708E+01, 0.30852E+01, 0.30994E+01, + & 0.31136E+01, 0.31275E+01, 0.31414E+01, 0.31551E+01, 0.31687E+01, + & 0.31821E+01, 0.31954E+01, 0.32086E+01, 0.32217E+01, 0.32346E+01, + & 0.32474E+01, 0.32601E+01, 0.32727E+01, 0.32852E+01, 0.32976E+01, + & 0.33098E+01, 0.33219E+01, 0.33339E+01, 0.33459E+01, 0.33577E+01, + & 0.33694E+01, 0.33810E+01, 0.33924E+01, 0.34038E+01, 0.34151E+01, + & 0.34263E+01, 0.34374E+01, 0.34484E+01, 0.34593E+01, 0.34701E+01, + & 0.34808E+01, 0.34914E+01, 0.35020E+01, 0.35124E+01, 0.35228E+01, + & 0.35330E+01, 0.35432E+01, 0.35533E+01, 0.35633E+01, 0.35732E+01, + & 0.35831E+01, 0.35928E+01, 0.36025E+01, 0.36121E+01, 0.36216E+01, + & 0.36311E+01, 0.36405E+01, 0.36497E+01, 0.36590E+01, 0.36681E+01/ + + DATA (BNC12M(I),I=701,741)/ + & 0.36772E+01, 0.36862E+01, 0.36951E+01, 0.37039E+01, 0.37127E+01, + & 0.37214E+01, 0.37301E+01, 0.37386E+01, 0.37472E+01, 0.37556E+01, + & 0.37640E+01, 0.37723E+01, 0.37805E+01, 0.37887E+01, 0.37968E+01, + & 0.38049E+01, 0.38129E+01, 0.38208E+01, 0.38287E+01, 0.38365E+01, + & 0.38442E+01, 0.38519E+01, 0.38595E+01, 0.38671E+01, 0.38746E+01, + & 0.38821E+01, 0.38895E+01, 0.38968E+01, 0.39041E+01, 0.39114E+01, + & 0.39186E+01, 0.39257E+01, 0.39328E+01, 0.39398E+01, 0.39468E+01, + & 0.39537E+01, 0.39606E+01, 0.39674E+01, 0.39742E+01, 0.39809E+01, + & 0.39875E+01 + & / +C +C *** (NH4)3H(SO4)2 +C + DATA (BNC13M (I),I= 1,100)/ + &-0.88457E-01,-0.16130E+00,-0.21283E+00,-0.24810E+00,-0.27543E+00, + &-0.29791E+00,-0.31709E+00,-0.33386E+00,-0.34878E+00,-0.36223E+00, + &-0.37448E+00,-0.38573E+00,-0.39614E+00,-0.40581E+00,-0.41486E+00, + &-0.42335E+00,-0.43134E+00,-0.43890E+00,-0.44605E+00,-0.45284E+00, + &-0.45930E+00,-0.46546E+00,-0.47134E+00,-0.47696E+00,-0.48234E+00, + &-0.48749E+00,-0.49244E+00,-0.49719E+00,-0.50176E+00,-0.50615E+00, + &-0.51038E+00,-0.51445E+00,-0.51838E+00,-0.52217E+00,-0.52582E+00, + &-0.52935E+00,-0.53275E+00,-0.53604E+00,-0.53922E+00,-0.54230E+00, + &-0.54527E+00,-0.54815E+00,-0.55093E+00,-0.55362E+00,-0.55622E+00, + &-0.55875E+00,-0.56119E+00,-0.56356E+00,-0.56585E+00,-0.56807E+00, + &-0.57023E+00,-0.57231E+00,-0.57434E+00,-0.57630E+00,-0.57820E+00, + &-0.58005E+00,-0.58183E+00,-0.58357E+00,-0.58525E+00,-0.58689E+00, + &-0.58847E+00,-0.59001E+00,-0.59151E+00,-0.59295E+00,-0.59436E+00, + &-0.59573E+00,-0.59705E+00,-0.59834E+00,-0.59958E+00,-0.60079E+00, + &-0.60197E+00,-0.60311E+00,-0.60421E+00,-0.60529E+00,-0.60633E+00, + &-0.60734E+00,-0.60831E+00,-0.60926E+00,-0.61018E+00,-0.61107E+00, + &-0.61193E+00,-0.61276E+00,-0.61356E+00,-0.61434E+00,-0.61509E+00, + &-0.61582E+00,-0.61652E+00,-0.61720E+00,-0.61786E+00,-0.61849E+00, + &-0.61909E+00,-0.61968E+00,-0.62024E+00,-0.62078E+00,-0.62130E+00, + &-0.62180E+00,-0.62229E+00,-0.62275E+00,-0.62319E+00,-0.62361E+00/ + + DATA (BNC13M (I),I=101,200)/ + &-0.62402E+00,-0.62441E+00,-0.62478E+00,-0.62514E+00,-0.62548E+00, + &-0.62581E+00,-0.62612E+00,-0.62642E+00,-0.62670E+00,-0.62697E+00, + &-0.62723E+00,-0.62748E+00,-0.62771E+00,-0.62793E+00,-0.62815E+00, + &-0.62835E+00,-0.62854E+00,-0.62873E+00,-0.62890E+00,-0.62907E+00, + &-0.62933E+00,-0.62947E+00,-0.62960E+00,-0.62973E+00,-0.62984E+00, + &-0.62996E+00,-0.63006E+00,-0.63017E+00,-0.63026E+00,-0.63036E+00, + &-0.63045E+00,-0.63053E+00,-0.63061E+00,-0.63068E+00,-0.63075E+00, + &-0.63082E+00,-0.63089E+00,-0.63095E+00,-0.63100E+00,-0.63106E+00, + &-0.63111E+00,-0.63116E+00,-0.63120E+00,-0.63125E+00,-0.63129E+00, + &-0.63132E+00,-0.63136E+00,-0.63139E+00,-0.63142E+00,-0.63145E+00, + &-0.63148E+00,-0.63150E+00,-0.63153E+00,-0.63155E+00,-0.63157E+00, + &-0.63159E+00,-0.63160E+00,-0.63162E+00,-0.63163E+00,-0.63165E+00, + &-0.63166E+00,-0.63167E+00,-0.63168E+00,-0.63169E+00,-0.63169E+00, + &-0.63170E+00,-0.63171E+00,-0.63171E+00,-0.63172E+00,-0.63172E+00, + &-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00, + &-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00, + &-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00, + &-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00, + &-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00, + &-0.63173E+00,-0.63173E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00/ + + DATA (BNC13M (I),I=201,300)/ + &-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63175E+00,-0.63175E+00, + &-0.63176E+00,-0.63176E+00,-0.63176E+00,-0.63177E+00,-0.63177E+00, + &-0.63178E+00,-0.63179E+00,-0.63179E+00,-0.63180E+00,-0.63181E+00, + &-0.63182E+00,-0.63183E+00,-0.63184E+00,-0.63185E+00,-0.63186E+00, + &-0.63187E+00,-0.63188E+00,-0.63189E+00,-0.63191E+00,-0.63192E+00, + &-0.63193E+00,-0.63195E+00,-0.63197E+00,-0.63198E+00,-0.63200E+00, + &-0.63202E+00,-0.63203E+00,-0.63205E+00,-0.63207E+00,-0.63209E+00, + &-0.63211E+00,-0.63214E+00,-0.63216E+00,-0.63218E+00,-0.63221E+00, + &-0.63223E+00,-0.63225E+00,-0.63228E+00,-0.63231E+00,-0.63233E+00, + &-0.63236E+00,-0.63239E+00,-0.63242E+00,-0.63245E+00,-0.63248E+00, + &-0.63251E+00,-0.63255E+00,-0.63258E+00,-0.63261E+00,-0.63265E+00, + &-0.63268E+00,-0.63272E+00,-0.63276E+00,-0.63280E+00,-0.63283E+00, + &-0.63287E+00,-0.63291E+00,-0.63296E+00,-0.63300E+00,-0.63304E+00, + &-0.63308E+00,-0.63313E+00,-0.63317E+00,-0.63322E+00,-0.63326E+00, + &-0.63331E+00,-0.63336E+00,-0.63341E+00,-0.63346E+00,-0.63351E+00, + &-0.63356E+00,-0.63361E+00,-0.63366E+00,-0.63372E+00,-0.63377E+00, + &-0.63383E+00,-0.63388E+00,-0.63394E+00,-0.63400E+00,-0.63406E+00, + &-0.63411E+00,-0.63417E+00,-0.63424E+00,-0.63430E+00,-0.63436E+00, + &-0.63442E+00,-0.63449E+00,-0.63455E+00,-0.63462E+00,-0.63468E+00, + &-0.63475E+00,-0.63482E+00,-0.63489E+00,-0.63496E+00,-0.63503E+00/ + + DATA (BNC13M (I),I=301,400)/ + &-0.63510E+00,-0.63517E+00,-0.63524E+00,-0.63531E+00,-0.63539E+00, + &-0.63546E+00,-0.63554E+00,-0.63562E+00,-0.63569E+00,-0.63577E+00, + &-0.63585E+00,-0.63593E+00,-0.63601E+00,-0.63609E+00,-0.63617E+00, + &-0.63626E+00,-0.63634E+00,-0.63643E+00,-0.63651E+00,-0.63660E+00, + &-0.63668E+00,-0.63677E+00,-0.63686E+00,-0.63695E+00,-0.63704E+00, + &-0.63713E+00,-0.63722E+00,-0.63731E+00,-0.63741E+00,-0.63750E+00, + &-0.63759E+00,-0.63769E+00,-0.63779E+00,-0.63788E+00,-0.63798E+00, + &-0.63808E+00,-0.63818E+00,-0.63828E+00,-0.63838E+00,-0.63848E+00, + &-0.63858E+00,-0.63869E+00,-0.63879E+00,-0.63889E+00,-0.63900E+00, + &-0.63911E+00,-0.63921E+00,-0.63932E+00,-0.63943E+00,-0.63954E+00, + &-0.63965E+00,-0.63976E+00,-0.63987E+00,-0.63998E+00,-0.64009E+00, + &-0.64021E+00,-0.64032E+00,-0.64044E+00,-0.64055E+00,-0.64067E+00, + &-0.64079E+00,-0.64090E+00,-0.64102E+00,-0.64114E+00,-0.64126E+00, + &-0.64138E+00,-0.64150E+00,-0.64163E+00,-0.64175E+00,-0.64187E+00, + &-0.64200E+00,-0.64212E+00,-0.64225E+00,-0.64238E+00,-0.64250E+00, + &-0.64263E+00,-0.64276E+00,-0.64289E+00,-0.64302E+00,-0.64315E+00, + &-0.64328E+00,-0.64342E+00,-0.64355E+00,-0.64368E+00,-0.64382E+00, + &-0.64395E+00,-0.64409E+00,-0.64423E+00,-0.64436E+00,-0.64450E+00, + &-0.64464E+00,-0.64478E+00,-0.64492E+00,-0.64506E+00,-0.64520E+00, + &-0.64534E+00,-0.64549E+00,-0.64563E+00,-0.64578E+00,-0.64592E+00/ + + DATA (BNC13M (I),I=401,500)/ + &-0.64607E+00,-0.64621E+00,-0.64636E+00,-0.64651E+00,-0.64666E+00, + &-0.64681E+00,-0.64696E+00,-0.64711E+00,-0.64726E+00,-0.64741E+00, + &-0.64756E+00,-0.64772E+00,-0.64787E+00,-0.64802E+00,-0.64818E+00, + &-0.64833E+00,-0.64849E+00,-0.64865E+00,-0.64881E+00,-0.64897E+00, + &-0.64912E+00,-0.64928E+00,-0.64944E+00,-0.64961E+00,-0.64977E+00, + &-0.64993E+00,-0.65009E+00,-0.65026E+00,-0.65042E+00,-0.65059E+00, + &-0.65075E+00,-0.65092E+00,-0.65109E+00,-0.65125E+00,-0.65142E+00, + &-0.65159E+00,-0.65176E+00,-0.65193E+00,-0.65210E+00,-0.65227E+00, + &-0.65245E+00,-0.65262E+00,-0.65279E+00,-0.65297E+00,-0.65314E+00, + &-0.65332E+00,-0.65349E+00,-0.65367E+00,-0.65385E+00,-0.65402E+00, + &-0.65420E+00,-0.65438E+00,-0.65456E+00,-0.65474E+00,-0.65492E+00, + &-0.65510E+00,-0.65529E+00,-0.65547E+00,-0.65565E+00,-0.65584E+00, + &-0.65602E+00,-0.65621E+00,-0.65639E+00,-0.65658E+00,-0.65677E+00, + &-0.65695E+00,-0.65714E+00,-0.65733E+00,-0.65752E+00,-0.65771E+00, + &-0.65790E+00,-0.65809E+00,-0.65828E+00,-0.65848E+00,-0.65867E+00, + &-0.65886E+00,-0.65906E+00,-0.65925E+00,-0.65945E+00,-0.65964E+00, + &-0.65984E+00,-0.66004E+00,-0.66024E+00,-0.66043E+00,-0.66063E+00, + &-0.66083E+00,-0.66103E+00,-0.66123E+00,-0.66143E+00,-0.66164E+00, + &-0.66184E+00,-0.66204E+00,-0.66225E+00,-0.66245E+00,-0.66265E+00, + &-0.66286E+00,-0.66307E+00,-0.66327E+00,-0.66348E+00,-0.66369E+00/ + + DATA (BNC13M (I),I=501,600)/ + &-0.66389E+00,-0.66410E+00,-0.66431E+00,-0.66452E+00,-0.66473E+00, + &-0.66494E+00,-0.66515E+00,-0.66537E+00,-0.66558E+00,-0.66579E+00, + &-0.66601E+00,-0.66622E+00,-0.66643E+00,-0.66665E+00,-0.66687E+00, + &-0.66708E+00,-0.66730E+00,-0.66752E+00,-0.66773E+00,-0.66795E+00, + &-0.66817E+00,-0.66839E+00,-0.66861E+00,-0.66883E+00,-0.66905E+00, + &-0.66928E+00,-0.66950E+00,-0.66972E+00,-0.66994E+00,-0.67017E+00, + &-0.67039E+00,-0.67062E+00,-0.67084E+00,-0.67107E+00,-0.67130E+00, + &-0.67152E+00,-0.67175E+00,-0.67198E+00,-0.67221E+00,-0.67244E+00, + &-0.67267E+00,-0.67290E+00,-0.67313E+00,-0.67336E+00,-0.67359E+00, + &-0.67382E+00,-0.67406E+00,-0.67429E+00,-0.67452E+00,-0.67476E+00, + &-0.67499E+00,-0.67523E+00,-0.67546E+00,-0.67570E+00,-0.67594E+00, + &-0.67617E+00,-0.67641E+00,-0.67665E+00,-0.67689E+00,-0.67713E+00, + &-0.67737E+00,-0.67761E+00,-0.67785E+00,-0.67809E+00,-0.67833E+00, + &-0.67857E+00,-0.67882E+00,-0.67906E+00,-0.67931E+00,-0.67955E+00, + &-0.67979E+00,-0.68004E+00,-0.68029E+00,-0.68053E+00,-0.68078E+00, + &-0.68103E+00,-0.68127E+00,-0.68152E+00,-0.68177E+00,-0.68202E+00, + &-0.68227E+00,-0.68252E+00,-0.68277E+00,-0.68302E+00,-0.68327E+00, + &-0.68352E+00,-0.68378E+00,-0.68403E+00,-0.68428E+00,-0.68454E+00, + &-0.68479E+00,-0.68505E+00,-0.68530E+00,-0.68556E+00,-0.68581E+00, + &-0.68607E+00,-0.68633E+00,-0.68659E+00,-0.68684E+00,-0.68782E+00/ + + DATA (BNC13M (I),I=601,700)/ + &-0.68998E+00,-0.69264E+00,-0.69534E+00,-0.69809E+00,-0.70088E+00, + &-0.70371E+00,-0.70659E+00,-0.70950E+00,-0.71245E+00,-0.71544E+00, + &-0.71847E+00,-0.72154E+00,-0.72464E+00,-0.72778E+00,-0.73095E+00, + &-0.73416E+00,-0.73741E+00,-0.74068E+00,-0.74399E+00,-0.74733E+00, + &-0.75070E+00,-0.75411E+00,-0.75754E+00,-0.76101E+00,-0.76450E+00, + &-0.76802E+00,-0.77157E+00,-0.77515E+00,-0.77876E+00,-0.78239E+00, + &-0.78605E+00,-0.78974E+00,-0.79345E+00,-0.79719E+00,-0.80095E+00, + &-0.80474E+00,-0.80855E+00,-0.81239E+00,-0.81625E+00,-0.82013E+00, + &-0.82403E+00,-0.82796E+00,-0.83191E+00,-0.83588E+00,-0.83987E+00, + &-0.84388E+00,-0.84792E+00,-0.85197E+00,-0.85604E+00,-0.86014E+00, + &-0.86425E+00,-0.86838E+00,-0.87253E+00,-0.87670E+00,-0.88089E+00, + &-0.88510E+00,-0.88932E+00,-0.89356E+00,-0.89782E+00,-0.90210E+00, + &-0.90639E+00,-0.91070E+00,-0.91503E+00,-0.91937E+00,-0.92373E+00, + &-0.92811E+00,-0.93250E+00,-0.93690E+00,-0.94132E+00,-0.94576E+00, + &-0.95021E+00,-0.95467E+00,-0.95915E+00,-0.96365E+00,-0.96815E+00, + &-0.97267E+00,-0.97721E+00,-0.98176E+00,-0.98632E+00,-0.99089E+00, + &-0.99548E+00,-0.10001E+01,-0.10047E+01,-0.10093E+01,-0.10140E+01, + &-0.10186E+01,-0.10233E+01,-0.10279E+01,-0.10326E+01,-0.10373E+01, + &-0.10420E+01,-0.10468E+01,-0.10515E+01,-0.10562E+01,-0.10610E+01, + &-0.10657E+01,-0.10705E+01,-0.10753E+01,-0.10801E+01,-0.10849E+01/ + + DATA (BNC13M(I),I=701,741)/ + &-0.10897E+01,-0.10945E+01,-0.10994E+01,-0.11042E+01,-0.11091E+01, + &-0.11139E+01,-0.11188E+01,-0.11237E+01,-0.11286E+01,-0.11335E+01, + &-0.11384E+01,-0.11433E+01,-0.11483E+01,-0.11532E+01,-0.11582E+01, + &-0.11631E+01,-0.11681E+01,-0.11730E+01,-0.11780E+01,-0.11830E+01, + &-0.11880E+01,-0.11930E+01,-0.11980E+01,-0.12031E+01,-0.12081E+01, + &-0.12131E+01,-0.12182E+01,-0.12232E+01,-0.12283E+01,-0.12333E+01, + &-0.12384E+01,-0.12435E+01,-0.12486E+01,-0.12537E+01,-0.12588E+01, + &-0.12639E+01,-0.12690E+01,-0.12741E+01,-0.12793E+01,-0.12844E+01, + &-0.12896E+01 + & / + END + +C *** TEMP = 248.0 + + BLOCK DATA KMCF248 +C +C *** Common block definition +C + COMMON /KMC248/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) +C +C *** NaCl +C + DATA (BNC01M (I),I= 1,100)/ + &-0.52363E-01,-0.92329E-01,-0.11821E+00,-0.13443E+00,-0.14598E+00, + &-0.15471E+00,-0.16154E+00,-0.16698E+00,-0.17138E+00,-0.17496E+00, + &-0.17787E+00,-0.18024E+00,-0.18214E+00,-0.18366E+00,-0.18484E+00, + &-0.18573E+00,-0.18637E+00,-0.18679E+00,-0.18701E+00,-0.18706E+00, + &-0.18695E+00,-0.18669E+00,-0.18632E+00,-0.18583E+00,-0.18523E+00, + &-0.18454E+00,-0.18377E+00,-0.18292E+00,-0.18200E+00,-0.18102E+00, + &-0.17998E+00,-0.17889E+00,-0.17775E+00,-0.17657E+00,-0.17535E+00, + &-0.17409E+00,-0.17280E+00,-0.17147E+00,-0.17013E+00,-0.16876E+00, + &-0.16736E+00,-0.16595E+00,-0.16452E+00,-0.16307E+00,-0.16161E+00, + &-0.16013E+00,-0.15865E+00,-0.15715E+00,-0.15565E+00,-0.15413E+00, + &-0.15261E+00,-0.15108E+00,-0.14954E+00,-0.14800E+00,-0.14645E+00, + &-0.14490E+00,-0.14334E+00,-0.14178E+00,-0.14021E+00,-0.13864E+00, + &-0.13706E+00,-0.13548E+00,-0.13389E+00,-0.13229E+00,-0.13069E+00, + &-0.12909E+00,-0.12747E+00,-0.12585E+00,-0.12422E+00,-0.12258E+00, + &-0.12094E+00,-0.11928E+00,-0.11762E+00,-0.11594E+00,-0.11426E+00, + &-0.11256E+00,-0.11085E+00,-0.10913E+00,-0.10740E+00,-0.10565E+00, + &-0.10389E+00,-0.10212E+00,-0.10033E+00,-0.98525E-01,-0.96708E-01, + &-0.94877E-01,-0.93031E-01,-0.91169E-01,-0.89293E-01,-0.87402E-01, + &-0.85495E-01,-0.83574E-01,-0.81638E-01,-0.79687E-01,-0.77722E-01, + &-0.75743E-01,-0.73749E-01,-0.71742E-01,-0.69722E-01,-0.67689E-01/ + + DATA (BNC01M (I),I=101,200)/ + &-0.65644E-01,-0.63586E-01,-0.61517E-01,-0.59436E-01,-0.57345E-01, + &-0.55244E-01,-0.53133E-01,-0.51013E-01,-0.48884E-01,-0.46747E-01, + &-0.44603E-01,-0.42451E-01,-0.40292E-01,-0.38127E-01,-0.35957E-01, + &-0.33781E-01,-0.31601E-01,-0.29416E-01,-0.27227E-01,-0.25035E-01, + &-0.23114E-01,-0.20884E-01,-0.18655E-01,-0.16426E-01,-0.14199E-01, + &-0.11973E-01,-0.97477E-02,-0.75237E-02,-0.53010E-02,-0.30795E-02, + &-0.85942E-03, 0.13593E-02, 0.35765E-02, 0.57922E-02, 0.80063E-02, + & 0.10219E-01, 0.12430E-01, 0.14638E-01, 0.16846E-01, 0.19051E-01, + & 0.21255E-01, 0.23456E-01, 0.25656E-01, 0.27853E-01, 0.30049E-01, + & 0.32242E-01, 0.34434E-01, 0.36623E-01, 0.38810E-01, 0.40994E-01, + & 0.43177E-01, 0.45357E-01, 0.47535E-01, 0.49710E-01, 0.51883E-01, + & 0.54053E-01, 0.56221E-01, 0.58387E-01, 0.60550E-01, 0.62710E-01, + & 0.64868E-01, 0.67024E-01, 0.69176E-01, 0.71326E-01, 0.73474E-01, + & 0.75618E-01, 0.77760E-01, 0.79899E-01, 0.82036E-01, 0.84169E-01, + & 0.86300E-01, 0.88428E-01, 0.90554E-01, 0.92676E-01, 0.94796E-01, + & 0.96912E-01, 0.99026E-01, 0.10114E+00, 0.10324E+00, 0.10535E+00, + & 0.10745E+00, 0.10955E+00, 0.11165E+00, 0.11374E+00, 0.11583E+00, + & 0.11792E+00, 0.12000E+00, 0.12208E+00, 0.12416E+00, 0.12624E+00, + & 0.12831E+00, 0.13038E+00, 0.13244E+00, 0.13450E+00, 0.13656E+00, + & 0.13862E+00, 0.14067E+00, 0.14272E+00, 0.14477E+00, 0.14681E+00/ + + DATA (BNC01M (I),I=201,300)/ + & 0.14886E+00, 0.15089E+00, 0.15293E+00, 0.15496E+00, 0.15699E+00, + & 0.15901E+00, 0.16103E+00, 0.16305E+00, 0.16507E+00, 0.16708E+00, + & 0.16909E+00, 0.17110E+00, 0.17310E+00, 0.17510E+00, 0.17709E+00, + & 0.17909E+00, 0.18108E+00, 0.18306E+00, 0.18505E+00, 0.18703E+00, + & 0.18901E+00, 0.19098E+00, 0.19295E+00, 0.19492E+00, 0.19688E+00, + & 0.19884E+00, 0.20080E+00, 0.20276E+00, 0.20471E+00, 0.20666E+00, + & 0.20860E+00, 0.21054E+00, 0.21248E+00, 0.21442E+00, 0.21635E+00, + & 0.21828E+00, 0.22020E+00, 0.22213E+00, 0.22405E+00, 0.22596E+00, + & 0.22788E+00, 0.22979E+00, 0.23169E+00, 0.23360E+00, 0.23550E+00, + & 0.23739E+00, 0.23929E+00, 0.24118E+00, 0.24306E+00, 0.24495E+00, + & 0.24683E+00, 0.24871E+00, 0.25058E+00, 0.25245E+00, 0.25432E+00, + & 0.25619E+00, 0.25805E+00, 0.25991E+00, 0.26177E+00, 0.26362E+00, + & 0.26547E+00, 0.26731E+00, 0.26916E+00, 0.27100E+00, 0.27283E+00, + & 0.27467E+00, 0.27650E+00, 0.27833E+00, 0.28015E+00, 0.28197E+00, + & 0.28379E+00, 0.28560E+00, 0.28742E+00, 0.28923E+00, 0.29103E+00, + & 0.29283E+00, 0.29463E+00, 0.29643E+00, 0.29822E+00, 0.30001E+00, + & 0.30180E+00, 0.30359E+00, 0.30537E+00, 0.30715E+00, 0.30892E+00, + & 0.31069E+00, 0.31246E+00, 0.31423E+00, 0.31599E+00, 0.31775E+00, + & 0.31951E+00, 0.32126E+00, 0.32301E+00, 0.32476E+00, 0.32651E+00, + & 0.32825E+00, 0.32999E+00, 0.33172E+00, 0.33346E+00, 0.33518E+00/ + + DATA (BNC01M (I),I=301,400)/ + & 0.33691E+00, 0.33864E+00, 0.34036E+00, 0.34208E+00, 0.34379E+00, + & 0.34550E+00, 0.34721E+00, 0.34892E+00, 0.35062E+00, 0.35232E+00, + & 0.35402E+00, 0.35571E+00, 0.35741E+00, 0.35910E+00, 0.36078E+00, + & 0.36246E+00, 0.36414E+00, 0.36582E+00, 0.36750E+00, 0.36917E+00, + & 0.37084E+00, 0.37250E+00, 0.37417E+00, 0.37583E+00, 0.37748E+00, + & 0.37914E+00, 0.38079E+00, 0.38244E+00, 0.38409E+00, 0.38573E+00, + & 0.38737E+00, 0.38901E+00, 0.39064E+00, 0.39227E+00, 0.39390E+00, + & 0.39553E+00, 0.39715E+00, 0.39877E+00, 0.40039E+00, 0.40201E+00, + & 0.40362E+00, 0.40523E+00, 0.40684E+00, 0.40844E+00, 0.41004E+00, + & 0.41164E+00, 0.41324E+00, 0.41483E+00, 0.41642E+00, 0.41801E+00, + & 0.41960E+00, 0.42118E+00, 0.42276E+00, 0.42434E+00, 0.42591E+00, + & 0.42749E+00, 0.42906E+00, 0.43062E+00, 0.43219E+00, 0.43375E+00, + & 0.43531E+00, 0.43686E+00, 0.43842E+00, 0.43997E+00, 0.44152E+00, + & 0.44306E+00, 0.44461E+00, 0.44615E+00, 0.44769E+00, 0.44922E+00, + & 0.45075E+00, 0.45229E+00, 0.45381E+00, 0.45534E+00, 0.45686E+00, + & 0.45838E+00, 0.45990E+00, 0.46141E+00, 0.46293E+00, 0.46444E+00, + & 0.46594E+00, 0.46745E+00, 0.46895E+00, 0.47045E+00, 0.47195E+00, + & 0.47344E+00, 0.47494E+00, 0.47643E+00, 0.47791E+00, 0.47940E+00, + & 0.48088E+00, 0.48236E+00, 0.48384E+00, 0.48532E+00, 0.48679E+00, + & 0.48826E+00, 0.48973E+00, 0.49119E+00, 0.49266E+00, 0.49412E+00/ + + DATA (BNC01M (I),I=401,500)/ + & 0.49557E+00, 0.49703E+00, 0.49848E+00, 0.49993E+00, 0.50138E+00, + & 0.50283E+00, 0.50427E+00, 0.50572E+00, 0.50715E+00, 0.50859E+00, + & 0.51003E+00, 0.51146E+00, 0.51289E+00, 0.51432E+00, 0.51574E+00, + & 0.51716E+00, 0.51858E+00, 0.52000E+00, 0.52142E+00, 0.52283E+00, + & 0.52424E+00, 0.52565E+00, 0.52706E+00, 0.52846E+00, 0.52986E+00, + & 0.53126E+00, 0.53266E+00, 0.53406E+00, 0.53545E+00, 0.53684E+00, + & 0.53823E+00, 0.53962E+00, 0.54100E+00, 0.54238E+00, 0.54376E+00, + & 0.54514E+00, 0.54651E+00, 0.54789E+00, 0.54926E+00, 0.55062E+00, + & 0.55199E+00, 0.55335E+00, 0.55472E+00, 0.55608E+00, 0.55743E+00, + & 0.55879E+00, 0.56014E+00, 0.56149E+00, 0.56284E+00, 0.56419E+00, + & 0.56553E+00, 0.56688E+00, 0.56822E+00, 0.56955E+00, 0.57089E+00, + & 0.57222E+00, 0.57356E+00, 0.57488E+00, 0.57621E+00, 0.57754E+00, + & 0.57886E+00, 0.58018E+00, 0.58150E+00, 0.58282E+00, 0.58413E+00, + & 0.58545E+00, 0.58676E+00, 0.58806E+00, 0.58937E+00, 0.59068E+00, + & 0.59198E+00, 0.59328E+00, 0.59458E+00, 0.59587E+00, 0.59717E+00, + & 0.59846E+00, 0.59975E+00, 0.60104E+00, 0.60232E+00, 0.60361E+00, + & 0.60489E+00, 0.60617E+00, 0.60745E+00, 0.60872E+00, 0.61000E+00, + & 0.61127E+00, 0.61254E+00, 0.61381E+00, 0.61508E+00, 0.61634E+00, + & 0.61760E+00, 0.61886E+00, 0.62012E+00, 0.62138E+00, 0.62263E+00, + & 0.62388E+00, 0.62513E+00, 0.62638E+00, 0.62763E+00, 0.62887E+00/ + + DATA (BNC01M (I),I=501,600)/ + & 0.63012E+00, 0.63136E+00, 0.63260E+00, 0.63383E+00, 0.63507E+00, + & 0.63630E+00, 0.63753E+00, 0.63876E+00, 0.63999E+00, 0.64122E+00, + & 0.64244E+00, 0.64366E+00, 0.64488E+00, 0.64610E+00, 0.64732E+00, + & 0.64853E+00, 0.64975E+00, 0.65096E+00, 0.65217E+00, 0.65337E+00, + & 0.65458E+00, 0.65578E+00, 0.65698E+00, 0.65818E+00, 0.65938E+00, + & 0.66058E+00, 0.66177E+00, 0.66296E+00, 0.66415E+00, 0.66534E+00, + & 0.66653E+00, 0.66772E+00, 0.66890E+00, 0.67008E+00, 0.67126E+00, + & 0.67244E+00, 0.67362E+00, 0.67479E+00, 0.67596E+00, 0.67713E+00, + & 0.67830E+00, 0.67947E+00, 0.68064E+00, 0.68180E+00, 0.68296E+00, + & 0.68412E+00, 0.68528E+00, 0.68644E+00, 0.68760E+00, 0.68875E+00, + & 0.68990E+00, 0.69105E+00, 0.69220E+00, 0.69335E+00, 0.69449E+00, + & 0.69563E+00, 0.69678E+00, 0.69792E+00, 0.69905E+00, 0.70019E+00, + & 0.70133E+00, 0.70246E+00, 0.70359E+00, 0.70472E+00, 0.70585E+00, + & 0.70698E+00, 0.70810E+00, 0.70922E+00, 0.71035E+00, 0.71147E+00, + & 0.71258E+00, 0.71370E+00, 0.71482E+00, 0.71593E+00, 0.71704E+00, + & 0.71815E+00, 0.71926E+00, 0.72037E+00, 0.72147E+00, 0.72258E+00, + & 0.72368E+00, 0.72478E+00, 0.72588E+00, 0.72697E+00, 0.72807E+00, + & 0.72916E+00, 0.73026E+00, 0.73135E+00, 0.73244E+00, 0.73352E+00, + & 0.73461E+00, 0.73569E+00, 0.73678E+00, 0.73786E+00, 0.73894E+00, + & 0.74002E+00, 0.74109E+00, 0.74217E+00, 0.74324E+00, 0.74725E+00/ + + DATA (BNC01M (I),I=601,700)/ + & 0.75600E+00, 0.76647E+00, 0.77680E+00, 0.78697E+00, 0.79701E+00, + & 0.80690E+00, 0.81666E+00, 0.82629E+00, 0.83578E+00, 0.84515E+00, + & 0.85439E+00, 0.86350E+00, 0.87250E+00, 0.88138E+00, 0.89014E+00, + & 0.89879E+00, 0.90732E+00, 0.91574E+00, 0.92406E+00, 0.93227E+00, + & 0.94038E+00, 0.94838E+00, 0.95628E+00, 0.96409E+00, 0.97180E+00, + & 0.97941E+00, 0.98693E+00, 0.99435E+00, 0.10017E+01, 0.10089E+01, + & 0.10161E+01, 0.10232E+01, 0.10302E+01, 0.10371E+01, 0.10439E+01, + & 0.10506E+01, 0.10573E+01, 0.10639E+01, 0.10704E+01, 0.10768E+01, + & 0.10832E+01, 0.10895E+01, 0.10957E+01, 0.11018E+01, 0.11079E+01, + & 0.11139E+01, 0.11199E+01, 0.11257E+01, 0.11315E+01, 0.11373E+01, + & 0.11430E+01, 0.11486E+01, 0.11541E+01, 0.11596E+01, 0.11651E+01, + & 0.11704E+01, 0.11757E+01, 0.11810E+01, 0.11862E+01, 0.11913E+01, + & 0.11964E+01, 0.12015E+01, 0.12064E+01, 0.12114E+01, 0.12162E+01, + & 0.12211E+01, 0.12258E+01, 0.12306E+01, 0.12352E+01, 0.12399E+01, + & 0.12444E+01, 0.12490E+01, 0.12534E+01, 0.12579E+01, 0.12623E+01, + & 0.12666E+01, 0.12709E+01, 0.12751E+01, 0.12794E+01, 0.12835E+01, + & 0.12876E+01, 0.12917E+01, 0.12958E+01, 0.12998E+01, 0.13037E+01, + & 0.13076E+01, 0.13115E+01, 0.13153E+01, 0.13191E+01, 0.13229E+01, + & 0.13266E+01, 0.13303E+01, 0.13340E+01, 0.13376E+01, 0.13411E+01, + & 0.13447E+01, 0.13482E+01, 0.13517E+01, 0.13551E+01, 0.13585E+01/ + + DATA (BNC01M(I),I=701,741)/ + & 0.13619E+01, 0.13652E+01, 0.13685E+01, 0.13718E+01, 0.13750E+01, + & 0.13782E+01, 0.13814E+01, 0.13845E+01, 0.13876E+01, 0.13907E+01, + & 0.13937E+01, 0.13967E+01, 0.13997E+01, 0.14027E+01, 0.14056E+01, + & 0.14085E+01, 0.14114E+01, 0.14142E+01, 0.14170E+01, 0.14198E+01, + & 0.14226E+01, 0.14253E+01, 0.14280E+01, 0.14307E+01, 0.14333E+01, + & 0.14360E+01, 0.14386E+01, 0.14411E+01, 0.14437E+01, 0.14462E+01, + & 0.14487E+01, 0.14512E+01, 0.14536E+01, 0.14561E+01, 0.14585E+01, + & 0.14608E+01, 0.14632E+01, 0.14655E+01, 0.14678E+01, 0.14701E+01, + & 0.14724E+01 + & / +C +C *** Na2SO4 +C + DATA (BNC02M (I),I= 1,100)/ + &-0.10845E+00,-0.19833E+00,-0.26217E+00,-0.30599E+00,-0.34002E+00, + &-0.36806E+00,-0.39204E+00,-0.41305E+00,-0.43179E+00,-0.44872E+00, + &-0.46420E+00,-0.47846E+00,-0.49169E+00,-0.50405E+00,-0.51565E+00, + &-0.52658E+00,-0.53693E+00,-0.54675E+00,-0.55611E+00,-0.56505E+00, + &-0.57361E+00,-0.58182E+00,-0.58971E+00,-0.59731E+00,-0.60464E+00, + &-0.61173E+00,-0.61858E+00,-0.62522E+00,-0.63166E+00,-0.63792E+00, + &-0.64400E+00,-0.64991E+00,-0.65567E+00,-0.66129E+00,-0.66676E+00, + &-0.67211E+00,-0.67733E+00,-0.68243E+00,-0.68742E+00,-0.69231E+00, + &-0.69710E+00,-0.70178E+00,-0.70638E+00,-0.71089E+00,-0.71531E+00, + &-0.71965E+00,-0.72392E+00,-0.72811E+00,-0.73222E+00,-0.73627E+00, + &-0.74026E+00,-0.74418E+00,-0.74803E+00,-0.75183E+00,-0.75558E+00, + &-0.75926E+00,-0.76290E+00,-0.76648E+00,-0.77002E+00,-0.77350E+00, + &-0.77695E+00,-0.78034E+00,-0.78370E+00,-0.78701E+00,-0.79029E+00, + &-0.79352E+00,-0.79672E+00,-0.79988E+00,-0.80301E+00,-0.80610E+00, + &-0.80916E+00,-0.81219E+00,-0.81519E+00,-0.81816E+00,-0.82110E+00, + &-0.82401E+00,-0.82689E+00,-0.82975E+00,-0.83259E+00,-0.83540E+00, + &-0.83818E+00,-0.84095E+00,-0.84369E+00,-0.84641E+00,-0.84911E+00, + &-0.85178E+00,-0.85444E+00,-0.85708E+00,-0.85970E+00,-0.86230E+00, + &-0.86488E+00,-0.86745E+00,-0.87000E+00,-0.87253E+00,-0.87505E+00, + &-0.87755E+00,-0.88003E+00,-0.88250E+00,-0.88495E+00,-0.88739E+00/ + + DATA (BNC02M (I),I=101,200)/ + &-0.88982E+00,-0.89223E+00,-0.89462E+00,-0.89700E+00,-0.89937E+00, + &-0.90173E+00,-0.90407E+00,-0.90640E+00,-0.90872E+00,-0.91102E+00, + &-0.91332E+00,-0.91560E+00,-0.91786E+00,-0.92012E+00,-0.92236E+00, + &-0.92460E+00,-0.92682E+00,-0.92903E+00,-0.93123E+00,-0.93342E+00, + &-0.93555E+00,-0.93772E+00,-0.93988E+00,-0.94203E+00,-0.94417E+00, + &-0.94629E+00,-0.94841E+00,-0.95052E+00,-0.95262E+00,-0.95470E+00, + &-0.95678E+00,-0.95885E+00,-0.96090E+00,-0.96295E+00,-0.96499E+00, + &-0.96702E+00,-0.96904E+00,-0.97105E+00,-0.97305E+00,-0.97505E+00, + &-0.97703E+00,-0.97901E+00,-0.98098E+00,-0.98294E+00,-0.98489E+00, + &-0.98683E+00,-0.98877E+00,-0.99070E+00,-0.99262E+00,-0.99453E+00, + &-0.99643E+00,-0.99833E+00,-0.10002E+01,-0.10021E+01,-0.10040E+01, + &-0.10058E+01,-0.10077E+01,-0.10096E+01,-0.10114E+01,-0.10133E+01, + &-0.10151E+01,-0.10169E+01,-0.10187E+01,-0.10205E+01,-0.10224E+01, + &-0.10242E+01,-0.10260E+01,-0.10277E+01,-0.10295E+01,-0.10313E+01, + &-0.10331E+01,-0.10348E+01,-0.10366E+01,-0.10384E+01,-0.10401E+01, + &-0.10418E+01,-0.10436E+01,-0.10453E+01,-0.10470E+01,-0.10488E+01, + &-0.10505E+01,-0.10522E+01,-0.10539E+01,-0.10556E+01,-0.10573E+01, + &-0.10590E+01,-0.10606E+01,-0.10623E+01,-0.10640E+01,-0.10657E+01, + &-0.10673E+01,-0.10690E+01,-0.10706E+01,-0.10723E+01,-0.10739E+01, + &-0.10756E+01,-0.10772E+01,-0.10788E+01,-0.10805E+01,-0.10821E+01/ + + DATA (BNC02M (I),I=201,300)/ + &-0.10837E+01,-0.10853E+01,-0.10869E+01,-0.10885E+01,-0.10901E+01, + &-0.10917E+01,-0.10933E+01,-0.10949E+01,-0.10965E+01,-0.10981E+01, + &-0.10997E+01,-0.11012E+01,-0.11028E+01,-0.11044E+01,-0.11059E+01, + &-0.11075E+01,-0.11090E+01,-0.11106E+01,-0.11121E+01,-0.11137E+01, + &-0.11152E+01,-0.11167E+01,-0.11183E+01,-0.11198E+01,-0.11213E+01, + &-0.11228E+01,-0.11243E+01,-0.11259E+01,-0.11274E+01,-0.11289E+01, + &-0.11304E+01,-0.11319E+01,-0.11334E+01,-0.11349E+01,-0.11364E+01, + &-0.11378E+01,-0.11393E+01,-0.11408E+01,-0.11423E+01,-0.11437E+01, + &-0.11452E+01,-0.11467E+01,-0.11481E+01,-0.11496E+01,-0.11511E+01, + &-0.11525E+01,-0.11540E+01,-0.11554E+01,-0.11569E+01,-0.11583E+01, + &-0.11597E+01,-0.11612E+01,-0.11626E+01,-0.11640E+01,-0.11655E+01, + &-0.11669E+01,-0.11683E+01,-0.11697E+01,-0.11711E+01,-0.11726E+01, + &-0.11740E+01,-0.11754E+01,-0.11768E+01,-0.11782E+01,-0.11796E+01, + &-0.11810E+01,-0.11824E+01,-0.11838E+01,-0.11852E+01,-0.11865E+01, + &-0.11879E+01,-0.11893E+01,-0.11907E+01,-0.11921E+01,-0.11934E+01, + &-0.11948E+01,-0.11962E+01,-0.11976E+01,-0.11989E+01,-0.12003E+01, + &-0.12016E+01,-0.12030E+01,-0.12044E+01,-0.12057E+01,-0.12071E+01, + &-0.12084E+01,-0.12098E+01,-0.12111E+01,-0.12124E+01,-0.12138E+01, + &-0.12151E+01,-0.12165E+01,-0.12178E+01,-0.12191E+01,-0.12204E+01, + &-0.12218E+01,-0.12231E+01,-0.12244E+01,-0.12257E+01,-0.12271E+01/ + + DATA (BNC02M (I),I=301,400)/ + &-0.12284E+01,-0.12297E+01,-0.12310E+01,-0.12323E+01,-0.12336E+01, + &-0.12349E+01,-0.12362E+01,-0.12375E+01,-0.12388E+01,-0.12401E+01, + &-0.12414E+01,-0.12427E+01,-0.12440E+01,-0.12453E+01,-0.12466E+01, + &-0.12479E+01,-0.12491E+01,-0.12504E+01,-0.12517E+01,-0.12530E+01, + &-0.12543E+01,-0.12555E+01,-0.12568E+01,-0.12581E+01,-0.12593E+01, + &-0.12606E+01,-0.12619E+01,-0.12631E+01,-0.12644E+01,-0.12657E+01, + &-0.12669E+01,-0.12682E+01,-0.12694E+01,-0.12707E+01,-0.12719E+01, + &-0.12732E+01,-0.12744E+01,-0.12757E+01,-0.12769E+01,-0.12782E+01, + &-0.12794E+01,-0.12806E+01,-0.12819E+01,-0.12831E+01,-0.12844E+01, + &-0.12856E+01,-0.12868E+01,-0.12880E+01,-0.12893E+01,-0.12905E+01, + &-0.12917E+01,-0.12930E+01,-0.12942E+01,-0.12954E+01,-0.12966E+01, + &-0.12978E+01,-0.12990E+01,-0.13003E+01,-0.13015E+01,-0.13027E+01, + &-0.13039E+01,-0.13051E+01,-0.13063E+01,-0.13075E+01,-0.13087E+01, + &-0.13099E+01,-0.13111E+01,-0.13123E+01,-0.13135E+01,-0.13147E+01, + &-0.13159E+01,-0.13171E+01,-0.13183E+01,-0.13195E+01,-0.13207E+01, + &-0.13219E+01,-0.13230E+01,-0.13242E+01,-0.13254E+01,-0.13266E+01, + &-0.13278E+01,-0.13290E+01,-0.13301E+01,-0.13313E+01,-0.13325E+01, + &-0.13337E+01,-0.13348E+01,-0.13360E+01,-0.13372E+01,-0.13383E+01, + &-0.13395E+01,-0.13407E+01,-0.13418E+01,-0.13430E+01,-0.13442E+01, + &-0.13453E+01,-0.13465E+01,-0.13476E+01,-0.13488E+01,-0.13500E+01/ + + DATA (BNC02M (I),I=401,500)/ + &-0.13511E+01,-0.13523E+01,-0.13534E+01,-0.13546E+01,-0.13557E+01, + &-0.13569E+01,-0.13580E+01,-0.13592E+01,-0.13603E+01,-0.13615E+01, + &-0.13626E+01,-0.13637E+01,-0.13649E+01,-0.13660E+01,-0.13672E+01, + &-0.13683E+01,-0.13694E+01,-0.13706E+01,-0.13717E+01,-0.13728E+01, + &-0.13740E+01,-0.13751E+01,-0.13762E+01,-0.13774E+01,-0.13785E+01, + &-0.13796E+01,-0.13807E+01,-0.13819E+01,-0.13830E+01,-0.13841E+01, + &-0.13852E+01,-0.13863E+01,-0.13875E+01,-0.13886E+01,-0.13897E+01, + &-0.13908E+01,-0.13919E+01,-0.13930E+01,-0.13941E+01,-0.13952E+01, + &-0.13964E+01,-0.13975E+01,-0.13986E+01,-0.13997E+01,-0.14008E+01, + &-0.14019E+01,-0.14030E+01,-0.14041E+01,-0.14052E+01,-0.14063E+01, + &-0.14074E+01,-0.14085E+01,-0.14096E+01,-0.14107E+01,-0.14118E+01, + &-0.14129E+01,-0.14140E+01,-0.14151E+01,-0.14162E+01,-0.14172E+01, + &-0.14183E+01,-0.14194E+01,-0.14205E+01,-0.14216E+01,-0.14227E+01, + &-0.14238E+01,-0.14249E+01,-0.14259E+01,-0.14270E+01,-0.14281E+01, + &-0.14292E+01,-0.14303E+01,-0.14313E+01,-0.14324E+01,-0.14335E+01, + &-0.14346E+01,-0.14356E+01,-0.14367E+01,-0.14378E+01,-0.14389E+01, + &-0.14399E+01,-0.14410E+01,-0.14421E+01,-0.14431E+01,-0.14442E+01, + &-0.14453E+01,-0.14463E+01,-0.14474E+01,-0.14485E+01,-0.14495E+01, + &-0.14506E+01,-0.14517E+01,-0.14527E+01,-0.14538E+01,-0.14548E+01, + &-0.14559E+01,-0.14569E+01,-0.14580E+01,-0.14591E+01,-0.14601E+01/ + + DATA (BNC02M (I),I=501,600)/ + &-0.14612E+01,-0.14622E+01,-0.14633E+01,-0.14643E+01,-0.14654E+01, + &-0.14664E+01,-0.14675E+01,-0.14685E+01,-0.14696E+01,-0.14706E+01, + &-0.14717E+01,-0.14727E+01,-0.14737E+01,-0.14748E+01,-0.14758E+01, + &-0.14769E+01,-0.14779E+01,-0.14790E+01,-0.14800E+01,-0.14810E+01, + &-0.14821E+01,-0.14831E+01,-0.14841E+01,-0.14852E+01,-0.14862E+01, + &-0.14872E+01,-0.14883E+01,-0.14893E+01,-0.14903E+01,-0.14914E+01, + &-0.14924E+01,-0.14934E+01,-0.14945E+01,-0.14955E+01,-0.14965E+01, + &-0.14975E+01,-0.14986E+01,-0.14996E+01,-0.15006E+01,-0.15016E+01, + &-0.15027E+01,-0.15037E+01,-0.15047E+01,-0.15057E+01,-0.15068E+01, + &-0.15078E+01,-0.15088E+01,-0.15098E+01,-0.15108E+01,-0.15118E+01, + &-0.15129E+01,-0.15139E+01,-0.15149E+01,-0.15159E+01,-0.15169E+01, + &-0.15179E+01,-0.15189E+01,-0.15200E+01,-0.15210E+01,-0.15220E+01, + &-0.15230E+01,-0.15240E+01,-0.15250E+01,-0.15260E+01,-0.15270E+01, + &-0.15280E+01,-0.15290E+01,-0.15300E+01,-0.15310E+01,-0.15320E+01, + &-0.15330E+01,-0.15340E+01,-0.15350E+01,-0.15360E+01,-0.15370E+01, + &-0.15380E+01,-0.15390E+01,-0.15400E+01,-0.15410E+01,-0.15420E+01, + &-0.15430E+01,-0.15440E+01,-0.15450E+01,-0.15460E+01,-0.15470E+01, + &-0.15480E+01,-0.15490E+01,-0.15500E+01,-0.15510E+01,-0.15520E+01, + &-0.15529E+01,-0.15539E+01,-0.15549E+01,-0.15559E+01,-0.15569E+01, + &-0.15579E+01,-0.15589E+01,-0.15599E+01,-0.15608E+01,-0.15645E+01/ + + DATA (BNC02M (I),I=601,700)/ + &-0.15726E+01,-0.15824E+01,-0.15921E+01,-0.16017E+01,-0.16113E+01, + &-0.16208E+01,-0.16303E+01,-0.16397E+01,-0.16491E+01,-0.16584E+01, + &-0.16677E+01,-0.16770E+01,-0.16862E+01,-0.16954E+01,-0.17045E+01, + &-0.17136E+01,-0.17226E+01,-0.17316E+01,-0.17406E+01,-0.17495E+01, + &-0.17584E+01,-0.17673E+01,-0.17761E+01,-0.17849E+01,-0.17937E+01, + &-0.18024E+01,-0.18111E+01,-0.18198E+01,-0.18284E+01,-0.18370E+01, + &-0.18456E+01,-0.18542E+01,-0.18627E+01,-0.18712E+01,-0.18797E+01, + &-0.18881E+01,-0.18966E+01,-0.19050E+01,-0.19133E+01,-0.19217E+01, + &-0.19300E+01,-0.19383E+01,-0.19466E+01,-0.19548E+01,-0.19631E+01, + &-0.19713E+01,-0.19795E+01,-0.19876E+01,-0.19958E+01,-0.20039E+01, + &-0.20120E+01,-0.20201E+01,-0.20282E+01,-0.20362E+01,-0.20443E+01, + &-0.20523E+01,-0.20603E+01,-0.20682E+01,-0.20762E+01,-0.20841E+01, + &-0.20921E+01,-0.21000E+01,-0.21079E+01,-0.21157E+01,-0.21236E+01, + &-0.21314E+01,-0.21393E+01,-0.21471E+01,-0.21549E+01,-0.21626E+01, + &-0.21704E+01,-0.21782E+01,-0.21859E+01,-0.21936E+01,-0.22013E+01, + &-0.22090E+01,-0.22167E+01,-0.22244E+01,-0.22320E+01,-0.22396E+01, + &-0.22473E+01,-0.22549E+01,-0.22625E+01,-0.22701E+01,-0.22776E+01, + &-0.22852E+01,-0.22928E+01,-0.23003E+01,-0.23078E+01,-0.23153E+01, + &-0.23228E+01,-0.23303E+01,-0.23378E+01,-0.23453E+01,-0.23527E+01, + &-0.23602E+01,-0.23676E+01,-0.23750E+01,-0.23825E+01,-0.23899E+01/ + + DATA (BNC02M(I),I=701,741)/ + &-0.23973E+01,-0.24046E+01,-0.24120E+01,-0.24194E+01,-0.24267E+01, + &-0.24341E+01,-0.24414E+01,-0.24487E+01,-0.24560E+01,-0.24633E+01, + &-0.24706E+01,-0.24779E+01,-0.24852E+01,-0.24925E+01,-0.24997E+01, + &-0.25070E+01,-0.25142E+01,-0.25214E+01,-0.25287E+01,-0.25359E+01, + &-0.25431E+01,-0.25503E+01,-0.25575E+01,-0.25647E+01,-0.25718E+01, + &-0.25790E+01,-0.25862E+01,-0.25933E+01,-0.26004E+01,-0.26076E+01, + &-0.26147E+01,-0.26218E+01,-0.26289E+01,-0.26360E+01,-0.26431E+01, + &-0.26502E+01,-0.26573E+01,-0.26644E+01,-0.26714E+01,-0.26785E+01, + &-0.26856E+01 + & / +C +C *** NaNO3 +C + DATA (BNC03M (I),I= 1,100)/ + &-0.54405E-01,-0.99825E-01,-0.13234E+00,-0.15482E+00,-0.17238E+00, + &-0.18693E+00,-0.19943E+00,-0.21044E+00,-0.22031E+00,-0.22926E+00, + &-0.23748E+00,-0.24508E+00,-0.25216E+00,-0.25880E+00,-0.26505E+00, + &-0.27097E+00,-0.27658E+00,-0.28194E+00,-0.28705E+00,-0.29195E+00, + &-0.29665E+00,-0.30117E+00,-0.30553E+00,-0.30975E+00,-0.31382E+00, + &-0.31776E+00,-0.32159E+00,-0.32530E+00,-0.32891E+00,-0.33243E+00, + &-0.33585E+00,-0.33918E+00,-0.34243E+00,-0.34561E+00,-0.34871E+00, + &-0.35175E+00,-0.35472E+00,-0.35762E+00,-0.36047E+00,-0.36326E+00, + &-0.36599E+00,-0.36868E+00,-0.37131E+00,-0.37389E+00,-0.37643E+00, + &-0.37893E+00,-0.38138E+00,-0.38379E+00,-0.38617E+00,-0.38850E+00, + &-0.39080E+00,-0.39307E+00,-0.39530E+00,-0.39749E+00,-0.39966E+00, + &-0.40180E+00,-0.40391E+00,-0.40598E+00,-0.40804E+00,-0.41006E+00, + &-0.41206E+00,-0.41404E+00,-0.41599E+00,-0.41792E+00,-0.41983E+00, + &-0.42172E+00,-0.42359E+00,-0.42543E+00,-0.42726E+00,-0.42907E+00, + &-0.43087E+00,-0.43264E+00,-0.43440E+00,-0.43615E+00,-0.43787E+00, + &-0.43959E+00,-0.44129E+00,-0.44298E+00,-0.44465E+00,-0.44631E+00, + &-0.44796E+00,-0.44959E+00,-0.45122E+00,-0.45283E+00,-0.45444E+00, + &-0.45603E+00,-0.45761E+00,-0.45918E+00,-0.46075E+00,-0.46230E+00, + &-0.46385E+00,-0.46538E+00,-0.46691E+00,-0.46843E+00,-0.46994E+00, + &-0.47145E+00,-0.47294E+00,-0.47443E+00,-0.47591E+00,-0.47739E+00/ + + DATA (BNC03M (I),I=101,200)/ + &-0.47885E+00,-0.48031E+00,-0.48176E+00,-0.48321E+00,-0.48465E+00, + &-0.48608E+00,-0.48750E+00,-0.48892E+00,-0.49033E+00,-0.49174E+00, + &-0.49314E+00,-0.49453E+00,-0.49591E+00,-0.49729E+00,-0.49867E+00, + &-0.50003E+00,-0.50139E+00,-0.50275E+00,-0.50410E+00,-0.50544E+00, + &-0.50673E+00,-0.50806E+00,-0.50939E+00,-0.51071E+00,-0.51203E+00, + &-0.51334E+00,-0.51465E+00,-0.51594E+00,-0.51724E+00,-0.51852E+00, + &-0.51980E+00,-0.52108E+00,-0.52235E+00,-0.52361E+00,-0.52487E+00, + &-0.52612E+00,-0.52737E+00,-0.52861E+00,-0.52985E+00,-0.53108E+00, + &-0.53230E+00,-0.53353E+00,-0.53474E+00,-0.53595E+00,-0.53716E+00, + &-0.53836E+00,-0.53956E+00,-0.54075E+00,-0.54194E+00,-0.54312E+00, + &-0.54430E+00,-0.54548E+00,-0.54664E+00,-0.54781E+00,-0.54897E+00, + &-0.55013E+00,-0.55128E+00,-0.55243E+00,-0.55357E+00,-0.55471E+00, + &-0.55585E+00,-0.55698E+00,-0.55811E+00,-0.55923E+00,-0.56035E+00, + &-0.56147E+00,-0.56258E+00,-0.56369E+00,-0.56480E+00,-0.56590E+00, + &-0.56699E+00,-0.56809E+00,-0.56918E+00,-0.57027E+00,-0.57135E+00, + &-0.57243E+00,-0.57351E+00,-0.57458E+00,-0.57565E+00,-0.57671E+00, + &-0.57778E+00,-0.57884E+00,-0.57989E+00,-0.58095E+00,-0.58200E+00, + &-0.58304E+00,-0.58409E+00,-0.58513E+00,-0.58617E+00,-0.58720E+00, + &-0.58823E+00,-0.58926E+00,-0.59029E+00,-0.59131E+00,-0.59233E+00, + &-0.59334E+00,-0.59436E+00,-0.59537E+00,-0.59638E+00,-0.59738E+00/ + + DATA (BNC03M (I),I=201,300)/ + &-0.59839E+00,-0.59939E+00,-0.60038E+00,-0.60138E+00,-0.60237E+00, + &-0.60336E+00,-0.60434E+00,-0.60533E+00,-0.60631E+00,-0.60729E+00, + &-0.60826E+00,-0.60924E+00,-0.61021E+00,-0.61118E+00,-0.61214E+00, + &-0.61311E+00,-0.61407E+00,-0.61503E+00,-0.61598E+00,-0.61694E+00, + &-0.61789E+00,-0.61884E+00,-0.61979E+00,-0.62073E+00,-0.62167E+00, + &-0.62261E+00,-0.62355E+00,-0.62449E+00,-0.62542E+00,-0.62635E+00, + &-0.62728E+00,-0.62821E+00,-0.62913E+00,-0.63005E+00,-0.63097E+00, + &-0.63189E+00,-0.63281E+00,-0.63372E+00,-0.63463E+00,-0.63554E+00, + &-0.63645E+00,-0.63736E+00,-0.63826E+00,-0.63916E+00,-0.64006E+00, + &-0.64096E+00,-0.64186E+00,-0.64275E+00,-0.64364E+00,-0.64453E+00, + &-0.64542E+00,-0.64631E+00,-0.64719E+00,-0.64807E+00,-0.64896E+00, + &-0.64983E+00,-0.65071E+00,-0.65159E+00,-0.65246E+00,-0.65333E+00, + &-0.65420E+00,-0.65507E+00,-0.65594E+00,-0.65680E+00,-0.65766E+00, + &-0.65852E+00,-0.65938E+00,-0.66024E+00,-0.66110E+00,-0.66195E+00, + &-0.66281E+00,-0.66366E+00,-0.66451E+00,-0.66535E+00,-0.66620E+00, + &-0.66704E+00,-0.66789E+00,-0.66873E+00,-0.66957E+00,-0.67041E+00, + &-0.67124E+00,-0.67208E+00,-0.67291E+00,-0.67374E+00,-0.67457E+00, + &-0.67540E+00,-0.67623E+00,-0.67705E+00,-0.67788E+00,-0.67870E+00, + &-0.67952E+00,-0.68034E+00,-0.68116E+00,-0.68198E+00,-0.68279E+00, + &-0.68361E+00,-0.68442E+00,-0.68523E+00,-0.68604E+00,-0.68685E+00/ + + DATA (BNC03M (I),I=301,400)/ + &-0.68766E+00,-0.68846E+00,-0.68927E+00,-0.69007E+00,-0.69087E+00, + &-0.69167E+00,-0.69247E+00,-0.69327E+00,-0.69406E+00,-0.69486E+00, + &-0.69565E+00,-0.69644E+00,-0.69723E+00,-0.69802E+00,-0.69881E+00, + &-0.69960E+00,-0.70038E+00,-0.70117E+00,-0.70195E+00,-0.70273E+00, + &-0.70351E+00,-0.70429E+00,-0.70507E+00,-0.70585E+00,-0.70662E+00, + &-0.70740E+00,-0.70817E+00,-0.70894E+00,-0.70971E+00,-0.71048E+00, + &-0.71125E+00,-0.71202E+00,-0.71278E+00,-0.71355E+00,-0.71431E+00, + &-0.71507E+00,-0.71583E+00,-0.71659E+00,-0.71735E+00,-0.71811E+00, + &-0.71887E+00,-0.71962E+00,-0.72038E+00,-0.72113E+00,-0.72188E+00, + &-0.72263E+00,-0.72338E+00,-0.72413E+00,-0.72488E+00,-0.72563E+00, + &-0.72637E+00,-0.72712E+00,-0.72786E+00,-0.72860E+00,-0.72935E+00, + &-0.73009E+00,-0.73083E+00,-0.73156E+00,-0.73230E+00,-0.73304E+00, + &-0.73377E+00,-0.73451E+00,-0.73524E+00,-0.73597E+00,-0.73670E+00, + &-0.73743E+00,-0.73816E+00,-0.73889E+00,-0.73962E+00,-0.74034E+00, + &-0.74107E+00,-0.74179E+00,-0.74252E+00,-0.74324E+00,-0.74396E+00, + &-0.74468E+00,-0.74540E+00,-0.74612E+00,-0.74683E+00,-0.74755E+00, + &-0.74827E+00,-0.74898E+00,-0.74969E+00,-0.75041E+00,-0.75112E+00, + &-0.75183E+00,-0.75254E+00,-0.75325E+00,-0.75396E+00,-0.75467E+00, + &-0.75537E+00,-0.75608E+00,-0.75678E+00,-0.75749E+00,-0.75819E+00, + &-0.75889E+00,-0.75959E+00,-0.76029E+00,-0.76099E+00,-0.76169E+00/ + + DATA (BNC03M (I),I=401,500)/ + &-0.76239E+00,-0.76308E+00,-0.76378E+00,-0.76447E+00,-0.76517E+00, + &-0.76586E+00,-0.76655E+00,-0.76725E+00,-0.76794E+00,-0.76863E+00, + &-0.76932E+00,-0.77001E+00,-0.77069E+00,-0.77138E+00,-0.77207E+00, + &-0.77275E+00,-0.77344E+00,-0.77412E+00,-0.77480E+00,-0.77548E+00, + &-0.77616E+00,-0.77684E+00,-0.77752E+00,-0.77820E+00,-0.77888E+00, + &-0.77956E+00,-0.78024E+00,-0.78091E+00,-0.78159E+00,-0.78226E+00, + &-0.78293E+00,-0.78361E+00,-0.78428E+00,-0.78495E+00,-0.78562E+00, + &-0.78629E+00,-0.78696E+00,-0.78763E+00,-0.78829E+00,-0.78896E+00, + &-0.78963E+00,-0.79029E+00,-0.79096E+00,-0.79162E+00,-0.79228E+00, + &-0.79295E+00,-0.79361E+00,-0.79427E+00,-0.79493E+00,-0.79559E+00, + &-0.79625E+00,-0.79691E+00,-0.79756E+00,-0.79822E+00,-0.79888E+00, + &-0.79953E+00,-0.80019E+00,-0.80084E+00,-0.80149E+00,-0.80215E+00, + &-0.80280E+00,-0.80345E+00,-0.80410E+00,-0.80475E+00,-0.80540E+00, + &-0.80605E+00,-0.80670E+00,-0.80734E+00,-0.80799E+00,-0.80864E+00, + &-0.80928E+00,-0.80993E+00,-0.81057E+00,-0.81121E+00,-0.81186E+00, + &-0.81250E+00,-0.81314E+00,-0.81378E+00,-0.81442E+00,-0.81506E+00, + &-0.81570E+00,-0.81634E+00,-0.81698E+00,-0.81761E+00,-0.81825E+00, + &-0.81888E+00,-0.81952E+00,-0.82015E+00,-0.82079E+00,-0.82142E+00, + &-0.82205E+00,-0.82269E+00,-0.82332E+00,-0.82395E+00,-0.82458E+00, + &-0.82521E+00,-0.82584E+00,-0.82647E+00,-0.82710E+00,-0.82772E+00/ + + DATA (BNC03M (I),I=501,600)/ + &-0.82835E+00,-0.82898E+00,-0.82960E+00,-0.83023E+00,-0.83085E+00, + &-0.83147E+00,-0.83210E+00,-0.83272E+00,-0.83334E+00,-0.83397E+00, + &-0.83459E+00,-0.83521E+00,-0.83583E+00,-0.83645E+00,-0.83706E+00, + &-0.83768E+00,-0.83830E+00,-0.83892E+00,-0.83953E+00,-0.84015E+00, + &-0.84077E+00,-0.84138E+00,-0.84200E+00,-0.84261E+00,-0.84322E+00, + &-0.84384E+00,-0.84445E+00,-0.84506E+00,-0.84567E+00,-0.84628E+00, + &-0.84689E+00,-0.84750E+00,-0.84811E+00,-0.84872E+00,-0.84933E+00, + &-0.84993E+00,-0.85054E+00,-0.85115E+00,-0.85175E+00,-0.85236E+00, + &-0.85296E+00,-0.85357E+00,-0.85417E+00,-0.85478E+00,-0.85538E+00, + &-0.85598E+00,-0.85658E+00,-0.85718E+00,-0.85779E+00,-0.85839E+00, + &-0.85899E+00,-0.85959E+00,-0.86018E+00,-0.86078E+00,-0.86138E+00, + &-0.86198E+00,-0.86257E+00,-0.86317E+00,-0.86377E+00,-0.86436E+00, + &-0.86496E+00,-0.86555E+00,-0.86615E+00,-0.86674E+00,-0.86733E+00, + &-0.86793E+00,-0.86852E+00,-0.86911E+00,-0.86970E+00,-0.87029E+00, + &-0.87088E+00,-0.87147E+00,-0.87206E+00,-0.87265E+00,-0.87324E+00, + &-0.87383E+00,-0.87441E+00,-0.87500E+00,-0.87559E+00,-0.87617E+00, + &-0.87676E+00,-0.87734E+00,-0.87793E+00,-0.87851E+00,-0.87910E+00, + &-0.87968E+00,-0.88026E+00,-0.88085E+00,-0.88143E+00,-0.88201E+00, + &-0.88259E+00,-0.88317E+00,-0.88375E+00,-0.88433E+00,-0.88491E+00, + &-0.88549E+00,-0.88607E+00,-0.88665E+00,-0.88723E+00,-0.88939E+00/ + + DATA (BNC03M (I),I=601,700)/ + &-0.89413E+00,-0.89983E+00,-0.90549E+00,-0.91112E+00,-0.91671E+00, + &-0.92226E+00,-0.92777E+00,-0.93325E+00,-0.93869E+00,-0.94410E+00, + &-0.94948E+00,-0.95483E+00,-0.96015E+00,-0.96543E+00,-0.97069E+00, + &-0.97592E+00,-0.98112E+00,-0.98629E+00,-0.99143E+00,-0.99655E+00, + &-0.10016E+01,-0.10067E+01,-0.10118E+01,-0.10168E+01,-0.10218E+01, + &-0.10267E+01,-0.10317E+01,-0.10366E+01,-0.10415E+01,-0.10464E+01, + &-0.10513E+01,-0.10561E+01,-0.10609E+01,-0.10658E+01,-0.10705E+01, + &-0.10753E+01,-0.10801E+01,-0.10848E+01,-0.10895E+01,-0.10942E+01, + &-0.10989E+01,-0.11035E+01,-0.11082E+01,-0.11128E+01,-0.11174E+01, + &-0.11220E+01,-0.11266E+01,-0.11311E+01,-0.11357E+01,-0.11402E+01, + &-0.11447E+01,-0.11493E+01,-0.11537E+01,-0.11582E+01,-0.11627E+01, + &-0.11671E+01,-0.11716E+01,-0.11760E+01,-0.11804E+01,-0.11848E+01, + &-0.11892E+01,-0.11936E+01,-0.11979E+01,-0.12023E+01,-0.12066E+01, + &-0.12109E+01,-0.12153E+01,-0.12196E+01,-0.12239E+01,-0.12281E+01, + &-0.12324E+01,-0.12367E+01,-0.12409E+01,-0.12452E+01,-0.12494E+01, + &-0.12536E+01,-0.12578E+01,-0.12620E+01,-0.12662E+01,-0.12704E+01, + &-0.12746E+01,-0.12787E+01,-0.12829E+01,-0.12870E+01,-0.12912E+01, + &-0.12953E+01,-0.12994E+01,-0.13035E+01,-0.13076E+01,-0.13117E+01, + &-0.13158E+01,-0.13199E+01,-0.13239E+01,-0.13280E+01,-0.13320E+01, + &-0.13361E+01,-0.13401E+01,-0.13441E+01,-0.13482E+01,-0.13522E+01/ + + DATA (BNC03M(I),I=701,741)/ + &-0.13562E+01,-0.13602E+01,-0.13642E+01,-0.13682E+01,-0.13721E+01, + &-0.13761E+01,-0.13801E+01,-0.13840E+01,-0.13880E+01,-0.13919E+01, + &-0.13959E+01,-0.13998E+01,-0.14037E+01,-0.14076E+01,-0.14115E+01, + &-0.14154E+01,-0.14193E+01,-0.14232E+01,-0.14271E+01,-0.14310E+01, + &-0.14349E+01,-0.14387E+01,-0.14426E+01,-0.14464E+01,-0.14503E+01, + &-0.14541E+01,-0.14580E+01,-0.14618E+01,-0.14656E+01,-0.14695E+01, + &-0.14733E+01,-0.14771E+01,-0.14809E+01,-0.14847E+01,-0.14885E+01, + &-0.14923E+01,-0.14961E+01,-0.14998E+01,-0.15036E+01,-0.15074E+01, + &-0.15112E+01 + & / +C +C *** (NH4)2SO4 +C + DATA (BNC04M (I),I= 1,100)/ + &-0.10856E+00,-0.19872E+00,-0.26292E+00,-0.30708E+00,-0.34142E+00, + &-0.36979E+00,-0.39407E+00,-0.41538E+00,-0.43441E+00,-0.45164E+00, + &-0.46739E+00,-0.48193E+00,-0.49544E+00,-0.50808E+00,-0.51994E+00, + &-0.53114E+00,-0.54176E+00,-0.55184E+00,-0.56146E+00,-0.57065E+00, + &-0.57946E+00,-0.58792E+00,-0.59606E+00,-0.60391E+00,-0.61148E+00, + &-0.61880E+00,-0.62590E+00,-0.63277E+00,-0.63944E+00,-0.64593E+00, + &-0.65223E+00,-0.65837E+00,-0.66435E+00,-0.67019E+00,-0.67588E+00, + &-0.68144E+00,-0.68688E+00,-0.69219E+00,-0.69739E+00,-0.70249E+00, + &-0.70748E+00,-0.71237E+00,-0.71716E+00,-0.72187E+00,-0.72648E+00, + &-0.73102E+00,-0.73548E+00,-0.73985E+00,-0.74416E+00,-0.74840E+00, + &-0.75256E+00,-0.75666E+00,-0.76070E+00,-0.76468E+00,-0.76860E+00, + &-0.77246E+00,-0.77627E+00,-0.78002E+00,-0.78373E+00,-0.78739E+00, + &-0.79099E+00,-0.79456E+00,-0.79808E+00,-0.80155E+00,-0.80499E+00, + &-0.80839E+00,-0.81175E+00,-0.81507E+00,-0.81835E+00,-0.82160E+00, + &-0.82482E+00,-0.82801E+00,-0.83116E+00,-0.83428E+00,-0.83738E+00, + &-0.84045E+00,-0.84349E+00,-0.84650E+00,-0.84949E+00,-0.85245E+00, + &-0.85539E+00,-0.85831E+00,-0.86120E+00,-0.86407E+00,-0.86692E+00, + &-0.86975E+00,-0.87256E+00,-0.87535E+00,-0.87812E+00,-0.88088E+00, + &-0.88361E+00,-0.88633E+00,-0.88903E+00,-0.89172E+00,-0.89438E+00, + &-0.89704E+00,-0.89967E+00,-0.90229E+00,-0.90490E+00,-0.90749E+00/ + + DATA (BNC04M (I),I=101,200)/ + &-0.91007E+00,-0.91263E+00,-0.91518E+00,-0.91772E+00,-0.92024E+00, + &-0.92275E+00,-0.92524E+00,-0.92772E+00,-0.93019E+00,-0.93265E+00, + &-0.93509E+00,-0.93752E+00,-0.93994E+00,-0.94235E+00,-0.94475E+00, + &-0.94713E+00,-0.94950E+00,-0.95186E+00,-0.95421E+00,-0.95655E+00, + &-0.95881E+00,-0.96113E+00,-0.96344E+00,-0.96574E+00,-0.96803E+00, + &-0.97031E+00,-0.97257E+00,-0.97483E+00,-0.97707E+00,-0.97930E+00, + &-0.98153E+00,-0.98374E+00,-0.98594E+00,-0.98813E+00,-0.99032E+00, + &-0.99249E+00,-0.99465E+00,-0.99681E+00,-0.99895E+00,-0.10011E+01, + &-0.10032E+01,-0.10053E+01,-0.10074E+01,-0.10095E+01,-0.10116E+01, + &-0.10137E+01,-0.10158E+01,-0.10179E+01,-0.10199E+01,-0.10220E+01, + &-0.10240E+01,-0.10260E+01,-0.10281E+01,-0.10301E+01,-0.10321E+01, + &-0.10341E+01,-0.10361E+01,-0.10381E+01,-0.10401E+01,-0.10420E+01, + &-0.10440E+01,-0.10460E+01,-0.10479E+01,-0.10499E+01,-0.10518E+01, + &-0.10537E+01,-0.10556E+01,-0.10576E+01,-0.10595E+01,-0.10614E+01, + &-0.10633E+01,-0.10652E+01,-0.10671E+01,-0.10689E+01,-0.10708E+01, + &-0.10727E+01,-0.10746E+01,-0.10764E+01,-0.10783E+01,-0.10801E+01, + &-0.10819E+01,-0.10838E+01,-0.10856E+01,-0.10874E+01,-0.10892E+01, + &-0.10911E+01,-0.10929E+01,-0.10947E+01,-0.10965E+01,-0.10983E+01, + &-0.11000E+01,-0.11018E+01,-0.11036E+01,-0.11054E+01,-0.11071E+01, + &-0.11089E+01,-0.11106E+01,-0.11124E+01,-0.11141E+01,-0.11159E+01/ + + DATA (BNC04M (I),I=201,300)/ + &-0.11176E+01,-0.11193E+01,-0.11211E+01,-0.11228E+01,-0.11245E+01, + &-0.11262E+01,-0.11279E+01,-0.11296E+01,-0.11313E+01,-0.11330E+01, + &-0.11347E+01,-0.11364E+01,-0.11381E+01,-0.11398E+01,-0.11414E+01, + &-0.11431E+01,-0.11448E+01,-0.11464E+01,-0.11481E+01,-0.11497E+01, + &-0.11514E+01,-0.11530E+01,-0.11547E+01,-0.11563E+01,-0.11579E+01, + &-0.11596E+01,-0.11612E+01,-0.11628E+01,-0.11644E+01,-0.11660E+01, + &-0.11677E+01,-0.11693E+01,-0.11709E+01,-0.11725E+01,-0.11741E+01, + &-0.11757E+01,-0.11772E+01,-0.11788E+01,-0.11804E+01,-0.11820E+01, + &-0.11836E+01,-0.11851E+01,-0.11867E+01,-0.11883E+01,-0.11898E+01, + &-0.11914E+01,-0.11929E+01,-0.11945E+01,-0.11960E+01,-0.11976E+01, + &-0.11991E+01,-0.12007E+01,-0.12022E+01,-0.12037E+01,-0.12053E+01, + &-0.12068E+01,-0.12083E+01,-0.12098E+01,-0.12114E+01,-0.12129E+01, + &-0.12144E+01,-0.12159E+01,-0.12174E+01,-0.12189E+01,-0.12204E+01, + &-0.12219E+01,-0.12234E+01,-0.12249E+01,-0.12264E+01,-0.12278E+01, + &-0.12293E+01,-0.12308E+01,-0.12323E+01,-0.12338E+01,-0.12352E+01, + &-0.12367E+01,-0.12382E+01,-0.12396E+01,-0.12411E+01,-0.12426E+01, + &-0.12440E+01,-0.12455E+01,-0.12469E+01,-0.12484E+01,-0.12498E+01, + &-0.12513E+01,-0.12527E+01,-0.12541E+01,-0.12556E+01,-0.12570E+01, + &-0.12584E+01,-0.12599E+01,-0.12613E+01,-0.12627E+01,-0.12641E+01, + &-0.12655E+01,-0.12670E+01,-0.12684E+01,-0.12698E+01,-0.12712E+01/ + + DATA (BNC04M (I),I=301,400)/ + &-0.12726E+01,-0.12740E+01,-0.12754E+01,-0.12768E+01,-0.12782E+01, + &-0.12796E+01,-0.12810E+01,-0.12824E+01,-0.12838E+01,-0.12852E+01, + &-0.12866E+01,-0.12879E+01,-0.12893E+01,-0.12907E+01,-0.12921E+01, + &-0.12934E+01,-0.12948E+01,-0.12962E+01,-0.12976E+01,-0.12989E+01, + &-0.13003E+01,-0.13016E+01,-0.13030E+01,-0.13044E+01,-0.13057E+01, + &-0.13071E+01,-0.13084E+01,-0.13098E+01,-0.13111E+01,-0.13125E+01, + &-0.13138E+01,-0.13152E+01,-0.13165E+01,-0.13178E+01,-0.13192E+01, + &-0.13205E+01,-0.13218E+01,-0.13232E+01,-0.13245E+01,-0.13258E+01, + &-0.13271E+01,-0.13285E+01,-0.13298E+01,-0.13311E+01,-0.13324E+01, + &-0.13337E+01,-0.13351E+01,-0.13364E+01,-0.13377E+01,-0.13390E+01, + &-0.13403E+01,-0.13416E+01,-0.13429E+01,-0.13442E+01,-0.13455E+01, + &-0.13468E+01,-0.13481E+01,-0.13494E+01,-0.13507E+01,-0.13520E+01, + &-0.13533E+01,-0.13546E+01,-0.13558E+01,-0.13571E+01,-0.13584E+01, + &-0.13597E+01,-0.13610E+01,-0.13623E+01,-0.13635E+01,-0.13648E+01, + &-0.13661E+01,-0.13674E+01,-0.13686E+01,-0.13699E+01,-0.13712E+01, + &-0.13724E+01,-0.13737E+01,-0.13750E+01,-0.13762E+01,-0.13775E+01, + &-0.13787E+01,-0.13800E+01,-0.13812E+01,-0.13825E+01,-0.13838E+01, + &-0.13850E+01,-0.13863E+01,-0.13875E+01,-0.13887E+01,-0.13900E+01, + &-0.13912E+01,-0.13925E+01,-0.13937E+01,-0.13950E+01,-0.13962E+01, + &-0.13974E+01,-0.13987E+01,-0.13999E+01,-0.14011E+01,-0.14024E+01/ + + DATA (BNC04M (I),I=401,500)/ + &-0.14036E+01,-0.14048E+01,-0.14060E+01,-0.14073E+01,-0.14085E+01, + &-0.14097E+01,-0.14109E+01,-0.14122E+01,-0.14134E+01,-0.14146E+01, + &-0.14158E+01,-0.14170E+01,-0.14182E+01,-0.14195E+01,-0.14207E+01, + &-0.14219E+01,-0.14231E+01,-0.14243E+01,-0.14255E+01,-0.14267E+01, + &-0.14279E+01,-0.14291E+01,-0.14303E+01,-0.14315E+01,-0.14327E+01, + &-0.14339E+01,-0.14351E+01,-0.14363E+01,-0.14375E+01,-0.14387E+01, + &-0.14399E+01,-0.14411E+01,-0.14422E+01,-0.14434E+01,-0.14446E+01, + &-0.14458E+01,-0.14470E+01,-0.14482E+01,-0.14493E+01,-0.14505E+01, + &-0.14517E+01,-0.14529E+01,-0.14541E+01,-0.14552E+01,-0.14564E+01, + &-0.14576E+01,-0.14587E+01,-0.14599E+01,-0.14611E+01,-0.14623E+01, + &-0.14634E+01,-0.14646E+01,-0.14658E+01,-0.14669E+01,-0.14681E+01, + &-0.14692E+01,-0.14704E+01,-0.14716E+01,-0.14727E+01,-0.14739E+01, + &-0.14750E+01,-0.14762E+01,-0.14773E+01,-0.14785E+01,-0.14797E+01, + &-0.14808E+01,-0.14820E+01,-0.14831E+01,-0.14842E+01,-0.14854E+01, + &-0.14865E+01,-0.14877E+01,-0.14888E+01,-0.14900E+01,-0.14911E+01, + &-0.14923E+01,-0.14934E+01,-0.14945E+01,-0.14957E+01,-0.14968E+01, + &-0.14979E+01,-0.14991E+01,-0.15002E+01,-0.15013E+01,-0.15025E+01, + &-0.15036E+01,-0.15047E+01,-0.15059E+01,-0.15070E+01,-0.15081E+01, + &-0.15092E+01,-0.15104E+01,-0.15115E+01,-0.15126E+01,-0.15137E+01, + &-0.15149E+01,-0.15160E+01,-0.15171E+01,-0.15182E+01,-0.15193E+01/ + + DATA (BNC04M (I),I=501,600)/ + &-0.15204E+01,-0.15216E+01,-0.15227E+01,-0.15238E+01,-0.15249E+01, + &-0.15260E+01,-0.15271E+01,-0.15282E+01,-0.15293E+01,-0.15305E+01, + &-0.15316E+01,-0.15327E+01,-0.15338E+01,-0.15349E+01,-0.15360E+01, + &-0.15371E+01,-0.15382E+01,-0.15393E+01,-0.15404E+01,-0.15415E+01, + &-0.15426E+01,-0.15437E+01,-0.15448E+01,-0.15459E+01,-0.15470E+01, + &-0.15481E+01,-0.15492E+01,-0.15502E+01,-0.15513E+01,-0.15524E+01, + &-0.15535E+01,-0.15546E+01,-0.15557E+01,-0.15568E+01,-0.15579E+01, + &-0.15590E+01,-0.15600E+01,-0.15611E+01,-0.15622E+01,-0.15633E+01, + &-0.15644E+01,-0.15655E+01,-0.15665E+01,-0.15676E+01,-0.15687E+01, + &-0.15698E+01,-0.15708E+01,-0.15719E+01,-0.15730E+01,-0.15741E+01, + &-0.15751E+01,-0.15762E+01,-0.15773E+01,-0.15784E+01,-0.15794E+01, + &-0.15805E+01,-0.15816E+01,-0.15826E+01,-0.15837E+01,-0.15848E+01, + &-0.15858E+01,-0.15869E+01,-0.15880E+01,-0.15890E+01,-0.15901E+01, + &-0.15912E+01,-0.15922E+01,-0.15933E+01,-0.15943E+01,-0.15954E+01, + &-0.15965E+01,-0.15975E+01,-0.15986E+01,-0.15996E+01,-0.16007E+01, + &-0.16017E+01,-0.16028E+01,-0.16038E+01,-0.16049E+01,-0.16059E+01, + &-0.16070E+01,-0.16080E+01,-0.16091E+01,-0.16101E+01,-0.16112E+01, + &-0.16122E+01,-0.16133E+01,-0.16143E+01,-0.16154E+01,-0.16164E+01, + &-0.16175E+01,-0.16185E+01,-0.16196E+01,-0.16206E+01,-0.16216E+01, + &-0.16227E+01,-0.16237E+01,-0.16248E+01,-0.16258E+01,-0.16297E+01/ + + DATA (BNC04M (I),I=601,700)/ + &-0.16382E+01,-0.16485E+01,-0.16587E+01,-0.16688E+01,-0.16789E+01, + &-0.16890E+01,-0.16989E+01,-0.17088E+01,-0.17187E+01,-0.17285E+01, + &-0.17383E+01,-0.17480E+01,-0.17576E+01,-0.17673E+01,-0.17768E+01, + &-0.17863E+01,-0.17958E+01,-0.18053E+01,-0.18146E+01,-0.18240E+01, + &-0.18333E+01,-0.18426E+01,-0.18518E+01,-0.18610E+01,-0.18702E+01, + &-0.18793E+01,-0.18884E+01,-0.18974E+01,-0.19065E+01,-0.19154E+01, + &-0.19244E+01,-0.19333E+01,-0.19422E+01,-0.19511E+01,-0.19599E+01, + &-0.19687E+01,-0.19775E+01,-0.19862E+01,-0.19949E+01,-0.20036E+01, + &-0.20123E+01,-0.20209E+01,-0.20295E+01,-0.20381E+01,-0.20466E+01, + &-0.20552E+01,-0.20637E+01,-0.20722E+01,-0.20806E+01,-0.20890E+01, + &-0.20975E+01,-0.21058E+01,-0.21142E+01,-0.21226E+01,-0.21309E+01, + &-0.21392E+01,-0.21475E+01,-0.21557E+01,-0.21640E+01,-0.21722E+01, + &-0.21804E+01,-0.21886E+01,-0.21968E+01,-0.22049E+01,-0.22130E+01, + &-0.22211E+01,-0.22292E+01,-0.22373E+01,-0.22454E+01,-0.22534E+01, + &-0.22614E+01,-0.22694E+01,-0.22774E+01,-0.22854E+01,-0.22933E+01, + &-0.23013E+01,-0.23092E+01,-0.23171E+01,-0.23250E+01,-0.23329E+01, + &-0.23408E+01,-0.23486E+01,-0.23564E+01,-0.23643E+01,-0.23721E+01, + &-0.23799E+01,-0.23876E+01,-0.23954E+01,-0.24032E+01,-0.24109E+01, + &-0.24186E+01,-0.24263E+01,-0.24340E+01,-0.24417E+01,-0.24494E+01, + &-0.24570E+01,-0.24647E+01,-0.24723E+01,-0.24800E+01,-0.24876E+01/ + + DATA (BNC04M(I),I=701,741)/ + &-0.24952E+01,-0.25028E+01,-0.25103E+01,-0.25179E+01,-0.25255E+01, + &-0.25330E+01,-0.25405E+01,-0.25481E+01,-0.25556E+01,-0.25631E+01, + &-0.25706E+01,-0.25780E+01,-0.25855E+01,-0.25930E+01,-0.26004E+01, + &-0.26079E+01,-0.26153E+01,-0.26227E+01,-0.26301E+01,-0.26375E+01, + &-0.26449E+01,-0.26523E+01,-0.26597E+01,-0.26670E+01,-0.26744E+01, + &-0.26817E+01,-0.26891E+01,-0.26964E+01,-0.27037E+01,-0.27110E+01, + &-0.27183E+01,-0.27256E+01,-0.27329E+01,-0.27401E+01,-0.27474E+01, + &-0.27547E+01,-0.27619E+01,-0.27692E+01,-0.27764E+01,-0.27836E+01, + &-0.27908E+01 + & / +C +C *** NH4NO3 +C + DATA (BNC05M (I),I= 1,100)/ + &-0.55115E-01,-0.10248E+00,-0.13740E+00,-0.16216E+00,-0.18192E+00, + &-0.19861E+00,-0.21320E+00,-0.22626E+00,-0.23813E+00,-0.24905E+00, + &-0.25921E+00,-0.26872E+00,-0.27769E+00,-0.28619E+00,-0.29428E+00, + &-0.30201E+00,-0.30943E+00,-0.31655E+00,-0.32341E+00,-0.33004E+00, + &-0.33646E+00,-0.34268E+00,-0.34871E+00,-0.35458E+00,-0.36029E+00, + &-0.36586E+00,-0.37128E+00,-0.37658E+00,-0.38176E+00,-0.38682E+00, + &-0.39178E+00,-0.39663E+00,-0.40138E+00,-0.40603E+00,-0.41060E+00, + &-0.41508E+00,-0.41948E+00,-0.42380E+00,-0.42805E+00,-0.43222E+00, + &-0.43632E+00,-0.44035E+00,-0.44432E+00,-0.44823E+00,-0.45207E+00, + &-0.45585E+00,-0.45958E+00,-0.46325E+00,-0.46687E+00,-0.47044E+00, + &-0.47395E+00,-0.47742E+00,-0.48084E+00,-0.48422E+00,-0.48755E+00, + &-0.49084E+00,-0.49409E+00,-0.49730E+00,-0.50048E+00,-0.50361E+00, + &-0.50671E+00,-0.50978E+00,-0.51282E+00,-0.51582E+00,-0.51880E+00, + &-0.52174E+00,-0.52466E+00,-0.52755E+00,-0.53041E+00,-0.53326E+00, + &-0.53607E+00,-0.53887E+00,-0.54164E+00,-0.54440E+00,-0.54713E+00, + &-0.54985E+00,-0.55255E+00,-0.55523E+00,-0.55790E+00,-0.56055E+00, + &-0.56319E+00,-0.56581E+00,-0.56842E+00,-0.57102E+00,-0.57360E+00, + &-0.57617E+00,-0.57874E+00,-0.58129E+00,-0.58383E+00,-0.58636E+00, + &-0.58888E+00,-0.59139E+00,-0.59389E+00,-0.59638E+00,-0.59887E+00, + &-0.60134E+00,-0.60381E+00,-0.60627E+00,-0.60872E+00,-0.61116E+00/ + + DATA (BNC05M (I),I=101,200)/ + &-0.61360E+00,-0.61602E+00,-0.61844E+00,-0.62085E+00,-0.62325E+00, + &-0.62565E+00,-0.62803E+00,-0.63041E+00,-0.63278E+00,-0.63514E+00, + &-0.63749E+00,-0.63983E+00,-0.64217E+00,-0.64449E+00,-0.64681E+00, + &-0.64912E+00,-0.65142E+00,-0.65371E+00,-0.65599E+00,-0.65827E+00, + &-0.66039E+00,-0.66266E+00,-0.66492E+00,-0.66718E+00,-0.66942E+00, + &-0.67165E+00,-0.67387E+00,-0.67608E+00,-0.67828E+00,-0.68047E+00, + &-0.68265E+00,-0.68482E+00,-0.68698E+00,-0.68914E+00,-0.69128E+00, + &-0.69341E+00,-0.69554E+00,-0.69765E+00,-0.69976E+00,-0.70186E+00, + &-0.70395E+00,-0.70603E+00,-0.70810E+00,-0.71016E+00,-0.71222E+00, + &-0.71426E+00,-0.71630E+00,-0.71833E+00,-0.72035E+00,-0.72237E+00, + &-0.72437E+00,-0.72637E+00,-0.72836E+00,-0.73034E+00,-0.73232E+00, + &-0.73428E+00,-0.73624E+00,-0.73820E+00,-0.74014E+00,-0.74208E+00, + &-0.74401E+00,-0.74593E+00,-0.74784E+00,-0.74975E+00,-0.75165E+00, + &-0.75355E+00,-0.75544E+00,-0.75732E+00,-0.75919E+00,-0.76106E+00, + &-0.76292E+00,-0.76477E+00,-0.76662E+00,-0.76846E+00,-0.77029E+00, + &-0.77212E+00,-0.77394E+00,-0.77575E+00,-0.77756E+00,-0.77936E+00, + &-0.78116E+00,-0.78295E+00,-0.78473E+00,-0.78651E+00,-0.78828E+00, + &-0.79005E+00,-0.79180E+00,-0.79356E+00,-0.79531E+00,-0.79705E+00, + &-0.79878E+00,-0.80051E+00,-0.80224E+00,-0.80396E+00,-0.80567E+00, + &-0.80738E+00,-0.80908E+00,-0.81078E+00,-0.81247E+00,-0.81416E+00/ + + DATA (BNC05M (I),I=201,300)/ + &-0.81584E+00,-0.81751E+00,-0.81918E+00,-0.82085E+00,-0.82251E+00, + &-0.82416E+00,-0.82581E+00,-0.82746E+00,-0.82910E+00,-0.83073E+00, + &-0.83236E+00,-0.83398E+00,-0.83560E+00,-0.83722E+00,-0.83883E+00, + &-0.84043E+00,-0.84203E+00,-0.84363E+00,-0.84522E+00,-0.84680E+00, + &-0.84839E+00,-0.84996E+00,-0.85153E+00,-0.85310E+00,-0.85466E+00, + &-0.85622E+00,-0.85778E+00,-0.85932E+00,-0.86087E+00,-0.86241E+00, + &-0.86395E+00,-0.86548E+00,-0.86700E+00,-0.86853E+00,-0.87005E+00, + &-0.87156E+00,-0.87307E+00,-0.87458E+00,-0.87608E+00,-0.87758E+00, + &-0.87907E+00,-0.88056E+00,-0.88204E+00,-0.88353E+00,-0.88500E+00, + &-0.88648E+00,-0.88794E+00,-0.88941E+00,-0.89087E+00,-0.89233E+00, + &-0.89378E+00,-0.89523E+00,-0.89668E+00,-0.89812E+00,-0.89956E+00, + &-0.90099E+00,-0.90242E+00,-0.90385E+00,-0.90527E+00,-0.90669E+00, + &-0.90811E+00,-0.90952E+00,-0.91093E+00,-0.91233E+00,-0.91373E+00, + &-0.91513E+00,-0.91653E+00,-0.91792E+00,-0.91930E+00,-0.92069E+00, + &-0.92207E+00,-0.92344E+00,-0.92482E+00,-0.92619E+00,-0.92755E+00, + &-0.92892E+00,-0.93028E+00,-0.93163E+00,-0.93299E+00,-0.93434E+00, + &-0.93568E+00,-0.93703E+00,-0.93837E+00,-0.93970E+00,-0.94104E+00, + &-0.94237E+00,-0.94369E+00,-0.94502E+00,-0.94634E+00,-0.94765E+00, + &-0.94897E+00,-0.95028E+00,-0.95159E+00,-0.95289E+00,-0.95420E+00, + &-0.95549E+00,-0.95679E+00,-0.95808E+00,-0.95937E+00,-0.96066E+00/ + + DATA (BNC05M (I),I=301,400)/ + &-0.96194E+00,-0.96323E+00,-0.96450E+00,-0.96578E+00,-0.96705E+00, + &-0.96832E+00,-0.96959E+00,-0.97085E+00,-0.97211E+00,-0.97337E+00, + &-0.97463E+00,-0.97588E+00,-0.97713E+00,-0.97837E+00,-0.97962E+00, + &-0.98086E+00,-0.98210E+00,-0.98333E+00,-0.98457E+00,-0.98580E+00, + &-0.98703E+00,-0.98825E+00,-0.98947E+00,-0.99069E+00,-0.99191E+00, + &-0.99312E+00,-0.99434E+00,-0.99554E+00,-0.99675E+00,-0.99796E+00, + &-0.99916E+00,-0.10004E+01,-0.10016E+01,-0.10027E+01,-0.10039E+01, + &-0.10051E+01,-0.10063E+01,-0.10075E+01,-0.10087E+01,-0.10099E+01, + &-0.10110E+01,-0.10122E+01,-0.10134E+01,-0.10145E+01,-0.10157E+01, + &-0.10169E+01,-0.10180E+01,-0.10192E+01,-0.10204E+01,-0.10215E+01, + &-0.10227E+01,-0.10238E+01,-0.10250E+01,-0.10261E+01,-0.10273E+01, + &-0.10284E+01,-0.10295E+01,-0.10307E+01,-0.10318E+01,-0.10329E+01, + &-0.10341E+01,-0.10352E+01,-0.10363E+01,-0.10374E+01,-0.10386E+01, + &-0.10397E+01,-0.10408E+01,-0.10419E+01,-0.10430E+01,-0.10441E+01, + &-0.10452E+01,-0.10464E+01,-0.10475E+01,-0.10486E+01,-0.10497E+01, + &-0.10508E+01,-0.10519E+01,-0.10529E+01,-0.10540E+01,-0.10551E+01, + &-0.10562E+01,-0.10573E+01,-0.10584E+01,-0.10595E+01,-0.10605E+01, + &-0.10616E+01,-0.10627E+01,-0.10638E+01,-0.10648E+01,-0.10659E+01, + &-0.10670E+01,-0.10680E+01,-0.10691E+01,-0.10702E+01,-0.10712E+01, + &-0.10723E+01,-0.10733E+01,-0.10744E+01,-0.10754E+01,-0.10765E+01/ + + DATA (BNC05M (I),I=401,500)/ + &-0.10775E+01,-0.10786E+01,-0.10796E+01,-0.10807E+01,-0.10817E+01, + &-0.10827E+01,-0.10838E+01,-0.10848E+01,-0.10859E+01,-0.10869E+01, + &-0.10879E+01,-0.10889E+01,-0.10900E+01,-0.10910E+01,-0.10920E+01, + &-0.10930E+01,-0.10941E+01,-0.10951E+01,-0.10961E+01,-0.10971E+01, + &-0.10981E+01,-0.10991E+01,-0.11001E+01,-0.11011E+01,-0.11021E+01, + &-0.11031E+01,-0.11041E+01,-0.11051E+01,-0.11061E+01,-0.11071E+01, + &-0.11081E+01,-0.11091E+01,-0.11101E+01,-0.11111E+01,-0.11121E+01, + &-0.11131E+01,-0.11141E+01,-0.11150E+01,-0.11160E+01,-0.11170E+01, + &-0.11180E+01,-0.11190E+01,-0.11199E+01,-0.11209E+01,-0.11219E+01, + &-0.11229E+01,-0.11238E+01,-0.11248E+01,-0.11258E+01,-0.11267E+01, + &-0.11277E+01,-0.11286E+01,-0.11296E+01,-0.11306E+01,-0.11315E+01, + &-0.11325E+01,-0.11334E+01,-0.11344E+01,-0.11353E+01,-0.11363E+01, + &-0.11372E+01,-0.11382E+01,-0.11391E+01,-0.11401E+01,-0.11410E+01, + &-0.11419E+01,-0.11429E+01,-0.11438E+01,-0.11448E+01,-0.11457E+01, + &-0.11466E+01,-0.11476E+01,-0.11485E+01,-0.11494E+01,-0.11503E+01, + &-0.11513E+01,-0.11522E+01,-0.11531E+01,-0.11540E+01,-0.11549E+01, + &-0.11559E+01,-0.11568E+01,-0.11577E+01,-0.11586E+01,-0.11595E+01, + &-0.11604E+01,-0.11614E+01,-0.11623E+01,-0.11632E+01,-0.11641E+01, + &-0.11650E+01,-0.11659E+01,-0.11668E+01,-0.11677E+01,-0.11686E+01, + &-0.11695E+01,-0.11704E+01,-0.11713E+01,-0.11722E+01,-0.11731E+01/ + + DATA (BNC05M (I),I=501,600)/ + &-0.11740E+01,-0.11748E+01,-0.11757E+01,-0.11766E+01,-0.11775E+01, + &-0.11784E+01,-0.11793E+01,-0.11802E+01,-0.11810E+01,-0.11819E+01, + &-0.11828E+01,-0.11837E+01,-0.11846E+01,-0.11854E+01,-0.11863E+01, + &-0.11872E+01,-0.11881E+01,-0.11889E+01,-0.11898E+01,-0.11907E+01, + &-0.11915E+01,-0.11924E+01,-0.11933E+01,-0.11941E+01,-0.11950E+01, + &-0.11958E+01,-0.11967E+01,-0.11976E+01,-0.11984E+01,-0.11993E+01, + &-0.12001E+01,-0.12010E+01,-0.12018E+01,-0.12027E+01,-0.12035E+01, + &-0.12044E+01,-0.12052E+01,-0.12061E+01,-0.12069E+01,-0.12078E+01, + &-0.12086E+01,-0.12095E+01,-0.12103E+01,-0.12111E+01,-0.12120E+01, + &-0.12128E+01,-0.12137E+01,-0.12145E+01,-0.12153E+01,-0.12162E+01, + &-0.12170E+01,-0.12178E+01,-0.12186E+01,-0.12195E+01,-0.12203E+01, + &-0.12211E+01,-0.12220E+01,-0.12228E+01,-0.12236E+01,-0.12244E+01, + &-0.12252E+01,-0.12261E+01,-0.12269E+01,-0.12277E+01,-0.12285E+01, + &-0.12293E+01,-0.12302E+01,-0.12310E+01,-0.12318E+01,-0.12326E+01, + &-0.12334E+01,-0.12342E+01,-0.12350E+01,-0.12358E+01,-0.12366E+01, + &-0.12374E+01,-0.12383E+01,-0.12391E+01,-0.12399E+01,-0.12407E+01, + &-0.12415E+01,-0.12423E+01,-0.12431E+01,-0.12439E+01,-0.12447E+01, + &-0.12455E+01,-0.12462E+01,-0.12470E+01,-0.12478E+01,-0.12486E+01, + &-0.12494E+01,-0.12502E+01,-0.12510E+01,-0.12518E+01,-0.12526E+01, + &-0.12534E+01,-0.12541E+01,-0.12549E+01,-0.12557E+01,-0.12586E+01/ + + DATA (BNC05M (I),I=601,700)/ + &-0.12650E+01,-0.12727E+01,-0.12803E+01,-0.12878E+01,-0.12952E+01, + &-0.13026E+01,-0.13098E+01,-0.13170E+01,-0.13241E+01,-0.13312E+01, + &-0.13381E+01,-0.13450E+01,-0.13519E+01,-0.13586E+01,-0.13654E+01, + &-0.13720E+01,-0.13786E+01,-0.13851E+01,-0.13916E+01,-0.13980E+01, + &-0.14044E+01,-0.14107E+01,-0.14169E+01,-0.14231E+01,-0.14293E+01, + &-0.14354E+01,-0.14415E+01,-0.14475E+01,-0.14534E+01,-0.14594E+01, + &-0.14652E+01,-0.14711E+01,-0.14769E+01,-0.14827E+01,-0.14884E+01, + &-0.14941E+01,-0.14997E+01,-0.15053E+01,-0.15109E+01,-0.15164E+01, + &-0.15219E+01,-0.15274E+01,-0.15328E+01,-0.15382E+01,-0.15436E+01, + &-0.15490E+01,-0.15543E+01,-0.15595E+01,-0.15648E+01,-0.15700E+01, + &-0.15752E+01,-0.15804E+01,-0.15855E+01,-0.15906E+01,-0.15957E+01, + &-0.16008E+01,-0.16058E+01,-0.16108E+01,-0.16158E+01,-0.16208E+01, + &-0.16257E+01,-0.16306E+01,-0.16355E+01,-0.16404E+01,-0.16452E+01, + &-0.16500E+01,-0.16548E+01,-0.16596E+01,-0.16644E+01,-0.16691E+01, + &-0.16739E+01,-0.16786E+01,-0.16832E+01,-0.16879E+01,-0.16926E+01, + &-0.16972E+01,-0.17018E+01,-0.17064E+01,-0.17110E+01,-0.17155E+01, + &-0.17201E+01,-0.17246E+01,-0.17291E+01,-0.17336E+01,-0.17381E+01, + &-0.17425E+01,-0.17470E+01,-0.17514E+01,-0.17558E+01,-0.17602E+01, + &-0.17646E+01,-0.17690E+01,-0.17733E+01,-0.17777E+01,-0.17820E+01, + &-0.17863E+01,-0.17906E+01,-0.17949E+01,-0.17992E+01,-0.18035E+01/ + + DATA (BNC05M(I),I=701,741)/ + &-0.18077E+01,-0.18119E+01,-0.18162E+01,-0.18204E+01,-0.18246E+01, + &-0.18288E+01,-0.18330E+01,-0.18371E+01,-0.18413E+01,-0.18454E+01, + &-0.18496E+01,-0.18537E+01,-0.18578E+01,-0.18619E+01,-0.18660E+01, + &-0.18701E+01,-0.18742E+01,-0.18782E+01,-0.18823E+01,-0.18863E+01, + &-0.18903E+01,-0.18944E+01,-0.18984E+01,-0.19024E+01,-0.19064E+01, + &-0.19104E+01,-0.19144E+01,-0.19183E+01,-0.19223E+01,-0.19262E+01, + &-0.19302E+01,-0.19341E+01,-0.19380E+01,-0.19419E+01,-0.19459E+01, + &-0.19498E+01,-0.19537E+01,-0.19575E+01,-0.19614E+01,-0.19653E+01, + &-0.19691E+01 + & / +C +C *** NH4Cl +C + DATA (BNC06M (I),I= 1,100)/ + &-0.53384E-01,-0.96046E-01,-0.12518E+00,-0.14446E+00,-0.15894E+00, + &-0.17052E+00,-0.18011E+00,-0.18828E+00,-0.19534E+00,-0.20155E+00, + &-0.20706E+00,-0.21199E+00,-0.21644E+00,-0.22048E+00,-0.22416E+00, + &-0.22754E+00,-0.23064E+00,-0.23350E+00,-0.23615E+00,-0.23861E+00, + &-0.24090E+00,-0.24303E+00,-0.24503E+00,-0.24689E+00,-0.24864E+00, + &-0.25028E+00,-0.25183E+00,-0.25329E+00,-0.25466E+00,-0.25596E+00, + &-0.25718E+00,-0.25834E+00,-0.25944E+00,-0.26049E+00,-0.26148E+00, + &-0.26242E+00,-0.26332E+00,-0.26418E+00,-0.26499E+00,-0.26577E+00, + &-0.26651E+00,-0.26722E+00,-0.26790E+00,-0.26856E+00,-0.26918E+00, + &-0.26978E+00,-0.27035E+00,-0.27091E+00,-0.27144E+00,-0.27195E+00, + &-0.27244E+00,-0.27291E+00,-0.27337E+00,-0.27380E+00,-0.27422E+00, + &-0.27463E+00,-0.27502E+00,-0.27540E+00,-0.27576E+00,-0.27611E+00, + &-0.27645E+00,-0.27677E+00,-0.27708E+00,-0.27738E+00,-0.27767E+00, + &-0.27794E+00,-0.27821E+00,-0.27846E+00,-0.27870E+00,-0.27892E+00, + &-0.27914E+00,-0.27935E+00,-0.27954E+00,-0.27972E+00,-0.27989E+00, + &-0.28005E+00,-0.28020E+00,-0.28034E+00,-0.28047E+00,-0.28058E+00, + &-0.28069E+00,-0.28078E+00,-0.28086E+00,-0.28093E+00,-0.28099E+00, + &-0.28104E+00,-0.28108E+00,-0.28111E+00,-0.28112E+00,-0.28113E+00, + &-0.28113E+00,-0.28111E+00,-0.28109E+00,-0.28106E+00,-0.28101E+00, + &-0.28096E+00,-0.28090E+00,-0.28083E+00,-0.28075E+00,-0.28066E+00/ + + DATA (BNC06M (I),I=101,200)/ + &-0.28057E+00,-0.28046E+00,-0.28035E+00,-0.28023E+00,-0.28010E+00, + &-0.27997E+00,-0.27983E+00,-0.27968E+00,-0.27953E+00,-0.27937E+00, + &-0.27920E+00,-0.27903E+00,-0.27886E+00,-0.27868E+00,-0.27849E+00, + &-0.27830E+00,-0.27810E+00,-0.27790E+00,-0.27770E+00,-0.27749E+00, + &-0.27738E+00,-0.27716E+00,-0.27693E+00,-0.27670E+00,-0.27647E+00, + &-0.27623E+00,-0.27600E+00,-0.27576E+00,-0.27552E+00,-0.27528E+00, + &-0.27503E+00,-0.27479E+00,-0.27454E+00,-0.27430E+00,-0.27405E+00, + &-0.27380E+00,-0.27355E+00,-0.27329E+00,-0.27304E+00,-0.27279E+00, + &-0.27253E+00,-0.27227E+00,-0.27201E+00,-0.27176E+00,-0.27149E+00, + &-0.27123E+00,-0.27097E+00,-0.27071E+00,-0.27044E+00,-0.27018E+00, + &-0.26991E+00,-0.26965E+00,-0.26938E+00,-0.26911E+00,-0.26885E+00, + &-0.26858E+00,-0.26831E+00,-0.26804E+00,-0.26777E+00,-0.26750E+00, + &-0.26723E+00,-0.26695E+00,-0.26668E+00,-0.26641E+00,-0.26614E+00, + &-0.26586E+00,-0.26559E+00,-0.26531E+00,-0.26504E+00,-0.26477E+00, + &-0.26449E+00,-0.26422E+00,-0.26394E+00,-0.26366E+00,-0.26339E+00, + &-0.26311E+00,-0.26284E+00,-0.26256E+00,-0.26228E+00,-0.26201E+00, + &-0.26173E+00,-0.26146E+00,-0.26118E+00,-0.26090E+00,-0.26063E+00, + &-0.26035E+00,-0.26007E+00,-0.25980E+00,-0.25952E+00,-0.25924E+00, + &-0.25897E+00,-0.25869E+00,-0.25841E+00,-0.25814E+00,-0.25786E+00, + &-0.25759E+00,-0.25731E+00,-0.25703E+00,-0.25676E+00,-0.25648E+00/ + + DATA (BNC06M (I),I=201,300)/ + &-0.25621E+00,-0.25593E+00,-0.25566E+00,-0.25538E+00,-0.25511E+00, + &-0.25483E+00,-0.25456E+00,-0.25429E+00,-0.25401E+00,-0.25374E+00, + &-0.25347E+00,-0.25319E+00,-0.25292E+00,-0.25265E+00,-0.25238E+00, + &-0.25211E+00,-0.25183E+00,-0.25156E+00,-0.25129E+00,-0.25102E+00, + &-0.25075E+00,-0.25048E+00,-0.25021E+00,-0.24994E+00,-0.24967E+00, + &-0.24941E+00,-0.24914E+00,-0.24887E+00,-0.24860E+00,-0.24834E+00, + &-0.24807E+00,-0.24780E+00,-0.24754E+00,-0.24727E+00,-0.24701E+00, + &-0.24674E+00,-0.24648E+00,-0.24622E+00,-0.24595E+00,-0.24569E+00, + &-0.24543E+00,-0.24517E+00,-0.24491E+00,-0.24464E+00,-0.24438E+00, + &-0.24412E+00,-0.24386E+00,-0.24360E+00,-0.24335E+00,-0.24309E+00, + &-0.24283E+00,-0.24257E+00,-0.24232E+00,-0.24206E+00,-0.24180E+00, + &-0.24155E+00,-0.24129E+00,-0.24104E+00,-0.24078E+00,-0.24053E+00, + &-0.24028E+00,-0.24002E+00,-0.23977E+00,-0.23952E+00,-0.23927E+00, + &-0.23902E+00,-0.23877E+00,-0.23852E+00,-0.23827E+00,-0.23802E+00, + &-0.23777E+00,-0.23753E+00,-0.23728E+00,-0.23703E+00,-0.23679E+00, + &-0.23654E+00,-0.23630E+00,-0.23605E+00,-0.23581E+00,-0.23556E+00, + &-0.23532E+00,-0.23508E+00,-0.23484E+00,-0.23460E+00,-0.23436E+00, + &-0.23412E+00,-0.23388E+00,-0.23364E+00,-0.23340E+00,-0.23316E+00, + &-0.23292E+00,-0.23269E+00,-0.23245E+00,-0.23221E+00,-0.23198E+00, + &-0.23174E+00,-0.23151E+00,-0.23128E+00,-0.23104E+00,-0.23081E+00/ + + DATA (BNC06M (I),I=301,400)/ + &-0.23058E+00,-0.23035E+00,-0.23012E+00,-0.22988E+00,-0.22965E+00, + &-0.22943E+00,-0.22920E+00,-0.22897E+00,-0.22874E+00,-0.22851E+00, + &-0.22829E+00,-0.22806E+00,-0.22784E+00,-0.22761E+00,-0.22739E+00, + &-0.22716E+00,-0.22694E+00,-0.22672E+00,-0.22649E+00,-0.22627E+00, + &-0.22605E+00,-0.22583E+00,-0.22561E+00,-0.22539E+00,-0.22517E+00, + &-0.22495E+00,-0.22474E+00,-0.22452E+00,-0.22430E+00,-0.22409E+00, + &-0.22387E+00,-0.22366E+00,-0.22344E+00,-0.22323E+00,-0.22301E+00, + &-0.22280E+00,-0.22259E+00,-0.22238E+00,-0.22217E+00,-0.22196E+00, + &-0.22175E+00,-0.22154E+00,-0.22133E+00,-0.22112E+00,-0.22091E+00, + &-0.22070E+00,-0.22050E+00,-0.22029E+00,-0.22008E+00,-0.21988E+00, + &-0.21968E+00,-0.21947E+00,-0.21927E+00,-0.21906E+00,-0.21886E+00, + &-0.21866E+00,-0.21846E+00,-0.21826E+00,-0.21806E+00,-0.21786E+00, + &-0.21766E+00,-0.21746E+00,-0.21726E+00,-0.21707E+00,-0.21687E+00, + &-0.21667E+00,-0.21648E+00,-0.21628E+00,-0.21609E+00,-0.21589E+00, + &-0.21570E+00,-0.21551E+00,-0.21531E+00,-0.21512E+00,-0.21493E+00, + &-0.21474E+00,-0.21455E+00,-0.21436E+00,-0.21417E+00,-0.21398E+00, + &-0.21379E+00,-0.21360E+00,-0.21342E+00,-0.21323E+00,-0.21304E+00, + &-0.21286E+00,-0.21267E+00,-0.21249E+00,-0.21230E+00,-0.21212E+00, + &-0.21194E+00,-0.21176E+00,-0.21157E+00,-0.21139E+00,-0.21121E+00, + &-0.21103E+00,-0.21085E+00,-0.21067E+00,-0.21049E+00,-0.21032E+00/ + + DATA (BNC06M (I),I=401,500)/ + &-0.21014E+00,-0.20996E+00,-0.20978E+00,-0.20961E+00,-0.20943E+00, + &-0.20926E+00,-0.20908E+00,-0.20891E+00,-0.20873E+00,-0.20856E+00, + &-0.20839E+00,-0.20822E+00,-0.20804E+00,-0.20787E+00,-0.20770E+00, + &-0.20753E+00,-0.20736E+00,-0.20720E+00,-0.20703E+00,-0.20686E+00, + &-0.20669E+00,-0.20652E+00,-0.20636E+00,-0.20619E+00,-0.20603E+00, + &-0.20586E+00,-0.20570E+00,-0.20553E+00,-0.20537E+00,-0.20521E+00, + &-0.20504E+00,-0.20488E+00,-0.20472E+00,-0.20456E+00,-0.20440E+00, + &-0.20424E+00,-0.20408E+00,-0.20392E+00,-0.20376E+00,-0.20361E+00, + &-0.20345E+00,-0.20329E+00,-0.20313E+00,-0.20298E+00,-0.20282E+00, + &-0.20267E+00,-0.20251E+00,-0.20236E+00,-0.20221E+00,-0.20205E+00, + &-0.20190E+00,-0.20175E+00,-0.20160E+00,-0.20145E+00,-0.20130E+00, + &-0.20114E+00,-0.20100E+00,-0.20085E+00,-0.20070E+00,-0.20055E+00, + &-0.20040E+00,-0.20025E+00,-0.20011E+00,-0.19996E+00,-0.19982E+00, + &-0.19967E+00,-0.19952E+00,-0.19938E+00,-0.19924E+00,-0.19909E+00, + &-0.19895E+00,-0.19881E+00,-0.19867E+00,-0.19852E+00,-0.19838E+00, + &-0.19824E+00,-0.19810E+00,-0.19796E+00,-0.19782E+00,-0.19768E+00, + &-0.19755E+00,-0.19741E+00,-0.19727E+00,-0.19713E+00,-0.19700E+00, + &-0.19686E+00,-0.19672E+00,-0.19659E+00,-0.19646E+00,-0.19632E+00, + &-0.19619E+00,-0.19605E+00,-0.19592E+00,-0.19579E+00,-0.19566E+00, + &-0.19552E+00,-0.19539E+00,-0.19526E+00,-0.19513E+00,-0.19500E+00/ + + DATA (BNC06M (I),I=501,600)/ + &-0.19487E+00,-0.19474E+00,-0.19462E+00,-0.19449E+00,-0.19436E+00, + &-0.19423E+00,-0.19411E+00,-0.19398E+00,-0.19386E+00,-0.19373E+00, + &-0.19361E+00,-0.19348E+00,-0.19336E+00,-0.19323E+00,-0.19311E+00, + &-0.19299E+00,-0.19286E+00,-0.19274E+00,-0.19262E+00,-0.19250E+00, + &-0.19238E+00,-0.19226E+00,-0.19214E+00,-0.19202E+00,-0.19190E+00, + &-0.19178E+00,-0.19167E+00,-0.19155E+00,-0.19143E+00,-0.19131E+00, + &-0.19120E+00,-0.19108E+00,-0.19097E+00,-0.19085E+00,-0.19074E+00, + &-0.19062E+00,-0.19051E+00,-0.19040E+00,-0.19028E+00,-0.19017E+00, + &-0.19006E+00,-0.18995E+00,-0.18984E+00,-0.18972E+00,-0.18961E+00, + &-0.18950E+00,-0.18939E+00,-0.18929E+00,-0.18918E+00,-0.18907E+00, + &-0.18896E+00,-0.18885E+00,-0.18875E+00,-0.18864E+00,-0.18853E+00, + &-0.18843E+00,-0.18832E+00,-0.18822E+00,-0.18811E+00,-0.18801E+00, + &-0.18790E+00,-0.18780E+00,-0.18770E+00,-0.18759E+00,-0.18749E+00, + &-0.18739E+00,-0.18729E+00,-0.18719E+00,-0.18709E+00,-0.18699E+00, + &-0.18689E+00,-0.18679E+00,-0.18669E+00,-0.18659E+00,-0.18649E+00, + &-0.18639E+00,-0.18629E+00,-0.18620E+00,-0.18610E+00,-0.18600E+00, + &-0.18591E+00,-0.18581E+00,-0.18572E+00,-0.18562E+00,-0.18553E+00, + &-0.18543E+00,-0.18534E+00,-0.18525E+00,-0.18515E+00,-0.18506E+00, + &-0.18497E+00,-0.18488E+00,-0.18478E+00,-0.18469E+00,-0.18460E+00, + &-0.18451E+00,-0.18442E+00,-0.18433E+00,-0.18424E+00,-0.18391E+00/ + + DATA (BNC06M (I),I=601,700)/ + &-0.18320E+00,-0.18237E+00,-0.18158E+00,-0.18083E+00,-0.18010E+00, + &-0.17942E+00,-0.17876E+00,-0.17814E+00,-0.17755E+00,-0.17700E+00, + &-0.17647E+00,-0.17597E+00,-0.17551E+00,-0.17507E+00,-0.17467E+00, + &-0.17429E+00,-0.17394E+00,-0.17362E+00,-0.17333E+00,-0.17306E+00, + &-0.17282E+00,-0.17260E+00,-0.17241E+00,-0.17225E+00,-0.17211E+00, + &-0.17200E+00,-0.17190E+00,-0.17184E+00,-0.17179E+00,-0.17177E+00, + &-0.17177E+00,-0.17180E+00,-0.17184E+00,-0.17191E+00,-0.17200E+00, + &-0.17210E+00,-0.17223E+00,-0.17238E+00,-0.17255E+00,-0.17274E+00, + &-0.17295E+00,-0.17318E+00,-0.17342E+00,-0.17369E+00,-0.17397E+00, + &-0.17427E+00,-0.17459E+00,-0.17493E+00,-0.17528E+00,-0.17565E+00, + &-0.17604E+00,-0.17644E+00,-0.17687E+00,-0.17730E+00,-0.17775E+00, + &-0.17822E+00,-0.17871E+00,-0.17921E+00,-0.17972E+00,-0.18025E+00, + &-0.18079E+00,-0.18135E+00,-0.18193E+00,-0.18251E+00,-0.18311E+00, + &-0.18373E+00,-0.18436E+00,-0.18500E+00,-0.18565E+00,-0.18632E+00, + &-0.18700E+00,-0.18770E+00,-0.18840E+00,-0.18912E+00,-0.18985E+00, + &-0.19060E+00,-0.19135E+00,-0.19212E+00,-0.19290E+00,-0.19369E+00, + &-0.19450E+00,-0.19531E+00,-0.19614E+00,-0.19697E+00,-0.19782E+00, + &-0.19868E+00,-0.19955E+00,-0.20043E+00,-0.20132E+00,-0.20222E+00, + &-0.20313E+00,-0.20405E+00,-0.20498E+00,-0.20592E+00,-0.20687E+00, + &-0.20783E+00,-0.20880E+00,-0.20978E+00,-0.21077E+00,-0.21177E+00/ + + DATA (BNC06M(I),I=701,741)/ + &-0.21278E+00,-0.21379E+00,-0.21482E+00,-0.21585E+00,-0.21690E+00, + &-0.21795E+00,-0.21901E+00,-0.22008E+00,-0.22116E+00,-0.22224E+00, + &-0.22334E+00,-0.22444E+00,-0.22555E+00,-0.22667E+00,-0.22780E+00, + &-0.22893E+00,-0.23007E+00,-0.23122E+00,-0.23238E+00,-0.23355E+00, + &-0.23472E+00,-0.23590E+00,-0.23709E+00,-0.23828E+00,-0.23949E+00, + &-0.24070E+00,-0.24191E+00,-0.24314E+00,-0.24437E+00,-0.24561E+00, + &-0.24685E+00,-0.24810E+00,-0.24936E+00,-0.25062E+00,-0.25189E+00, + &-0.25317E+00,-0.25446E+00,-0.25575E+00,-0.25704E+00,-0.25835E+00, + &-0.25966E+00 + & / +C +C *** (2H, SO4) +C + DATA (BNC07M (I),I= 1,100)/ + &-0.10830E+00,-0.19774E+00,-0.26106E+00,-0.30438E+00,-0.33792E+00, + &-0.36551E+00,-0.38903E+00,-0.40959E+00,-0.42789E+00,-0.44440E+00, + &-0.45945E+00,-0.47329E+00,-0.48612E+00,-0.49807E+00,-0.50926E+00, + &-0.51980E+00,-0.52976E+00,-0.53920E+00,-0.54817E+00,-0.55673E+00, + &-0.56491E+00,-0.57275E+00,-0.58028E+00,-0.58752E+00,-0.59449E+00, + &-0.60122E+00,-0.60772E+00,-0.61401E+00,-0.62011E+00,-0.62602E+00, + &-0.63176E+00,-0.63734E+00,-0.64277E+00,-0.64805E+00,-0.65321E+00, + &-0.65823E+00,-0.66313E+00,-0.66792E+00,-0.67261E+00,-0.67718E+00, + &-0.68166E+00,-0.68605E+00,-0.69035E+00,-0.69456E+00,-0.69869E+00, + &-0.70275E+00,-0.70673E+00,-0.71063E+00,-0.71447E+00,-0.71824E+00, + &-0.72195E+00,-0.72560E+00,-0.72919E+00,-0.73272E+00,-0.73620E+00, + &-0.73963E+00,-0.74301E+00,-0.74633E+00,-0.74961E+00,-0.75285E+00, + &-0.75604E+00,-0.75919E+00,-0.76230E+00,-0.76537E+00,-0.76840E+00, + &-0.77139E+00,-0.77435E+00,-0.77727E+00,-0.78016E+00,-0.78302E+00, + &-0.78584E+00,-0.78863E+00,-0.79140E+00,-0.79414E+00,-0.79684E+00, + &-0.79952E+00,-0.80218E+00,-0.80481E+00,-0.80741E+00,-0.80999E+00, + &-0.81255E+00,-0.81509E+00,-0.81760E+00,-0.82009E+00,-0.82256E+00, + &-0.82501E+00,-0.82744E+00,-0.82985E+00,-0.83224E+00,-0.83461E+00, + &-0.83697E+00,-0.83930E+00,-0.84162E+00,-0.84393E+00,-0.84621E+00, + &-0.84848E+00,-0.85074E+00,-0.85298E+00,-0.85520E+00,-0.85741E+00/ + + DATA (BNC07M (I),I=101,200)/ + &-0.85961E+00,-0.86179E+00,-0.86396E+00,-0.86611E+00,-0.86825E+00, + &-0.87038E+00,-0.87249E+00,-0.87459E+00,-0.87668E+00,-0.87876E+00, + &-0.88082E+00,-0.88287E+00,-0.88491E+00,-0.88694E+00,-0.88896E+00, + &-0.89097E+00,-0.89296E+00,-0.89495E+00,-0.89692E+00,-0.89888E+00, + &-0.90081E+00,-0.90275E+00,-0.90469E+00,-0.90661E+00,-0.90853E+00, + &-0.91043E+00,-0.91233E+00,-0.91421E+00,-0.91609E+00,-0.91795E+00, + &-0.91981E+00,-0.92166E+00,-0.92349E+00,-0.92532E+00,-0.92715E+00, + &-0.92896E+00,-0.93076E+00,-0.93256E+00,-0.93435E+00,-0.93613E+00, + &-0.93790E+00,-0.93966E+00,-0.94142E+00,-0.94317E+00,-0.94491E+00, + &-0.94664E+00,-0.94837E+00,-0.95009E+00,-0.95180E+00,-0.95351E+00, + &-0.95521E+00,-0.95690E+00,-0.95858E+00,-0.96026E+00,-0.96193E+00, + &-0.96360E+00,-0.96525E+00,-0.96691E+00,-0.96855E+00,-0.97019E+00, + &-0.97183E+00,-0.97345E+00,-0.97508E+00,-0.97669E+00,-0.97830E+00, + &-0.97991E+00,-0.98150E+00,-0.98310E+00,-0.98469E+00,-0.98627E+00, + &-0.98784E+00,-0.98942E+00,-0.99098E+00,-0.99254E+00,-0.99410E+00, + &-0.99565E+00,-0.99719E+00,-0.99873E+00,-0.10003E+01,-0.10018E+01, + &-0.10033E+01,-0.10048E+01,-0.10064E+01,-0.10079E+01,-0.10094E+01, + &-0.10109E+01,-0.10124E+01,-0.10139E+01,-0.10154E+01,-0.10168E+01, + &-0.10183E+01,-0.10198E+01,-0.10213E+01,-0.10227E+01,-0.10242E+01, + &-0.10257E+01,-0.10271E+01,-0.10286E+01,-0.10300E+01,-0.10315E+01/ + + DATA (BNC07M (I),I=201,300)/ + &-0.10329E+01,-0.10343E+01,-0.10358E+01,-0.10372E+01,-0.10386E+01, + &-0.10400E+01,-0.10415E+01,-0.10429E+01,-0.10443E+01,-0.10457E+01, + &-0.10471E+01,-0.10485E+01,-0.10499E+01,-0.10513E+01,-0.10527E+01, + &-0.10540E+01,-0.10554E+01,-0.10568E+01,-0.10582E+01,-0.10595E+01, + &-0.10609E+01,-0.10623E+01,-0.10636E+01,-0.10650E+01,-0.10663E+01, + &-0.10677E+01,-0.10690E+01,-0.10704E+01,-0.10717E+01,-0.10731E+01, + &-0.10744E+01,-0.10757E+01,-0.10771E+01,-0.10784E+01,-0.10797E+01, + &-0.10810E+01,-0.10824E+01,-0.10837E+01,-0.10850E+01,-0.10863E+01, + &-0.10876E+01,-0.10889E+01,-0.10902E+01,-0.10915E+01,-0.10928E+01, + &-0.10941E+01,-0.10954E+01,-0.10967E+01,-0.10980E+01,-0.10993E+01, + &-0.11005E+01,-0.11018E+01,-0.11031E+01,-0.11044E+01,-0.11056E+01, + &-0.11069E+01,-0.11082E+01,-0.11094E+01,-0.11107E+01,-0.11120E+01, + &-0.11132E+01,-0.11145E+01,-0.11157E+01,-0.11170E+01,-0.11182E+01, + &-0.11195E+01,-0.11207E+01,-0.11220E+01,-0.11232E+01,-0.11244E+01, + &-0.11257E+01,-0.11269E+01,-0.11281E+01,-0.11294E+01,-0.11306E+01, + &-0.11318E+01,-0.11330E+01,-0.11342E+01,-0.11355E+01,-0.11367E+01, + &-0.11379E+01,-0.11391E+01,-0.11403E+01,-0.11415E+01,-0.11427E+01, + &-0.11439E+01,-0.11451E+01,-0.11463E+01,-0.11475E+01,-0.11487E+01, + &-0.11499E+01,-0.11511E+01,-0.11523E+01,-0.11535E+01,-0.11547E+01, + &-0.11559E+01,-0.11570E+01,-0.11582E+01,-0.11594E+01,-0.11606E+01/ + + DATA (BNC07M (I),I=301,400)/ + &-0.11617E+01,-0.11629E+01,-0.11641E+01,-0.11653E+01,-0.11664E+01, + &-0.11676E+01,-0.11688E+01,-0.11699E+01,-0.11711E+01,-0.11722E+01, + &-0.11734E+01,-0.11746E+01,-0.11757E+01,-0.11769E+01,-0.11780E+01, + &-0.11792E+01,-0.11803E+01,-0.11815E+01,-0.11826E+01,-0.11837E+01, + &-0.11849E+01,-0.11860E+01,-0.11872E+01,-0.11883E+01,-0.11894E+01, + &-0.11906E+01,-0.11917E+01,-0.11928E+01,-0.11940E+01,-0.11951E+01, + &-0.11962E+01,-0.11973E+01,-0.11985E+01,-0.11996E+01,-0.12007E+01, + &-0.12018E+01,-0.12029E+01,-0.12041E+01,-0.12052E+01,-0.12063E+01, + &-0.12074E+01,-0.12085E+01,-0.12096E+01,-0.12107E+01,-0.12118E+01, + &-0.12129E+01,-0.12140E+01,-0.12151E+01,-0.12162E+01,-0.12173E+01, + &-0.12184E+01,-0.12195E+01,-0.12206E+01,-0.12217E+01,-0.12228E+01, + &-0.12239E+01,-0.12250E+01,-0.12261E+01,-0.12272E+01,-0.12283E+01, + &-0.12293E+01,-0.12304E+01,-0.12315E+01,-0.12326E+01,-0.12337E+01, + &-0.12348E+01,-0.12358E+01,-0.12369E+01,-0.12380E+01,-0.12391E+01, + &-0.12401E+01,-0.12412E+01,-0.12423E+01,-0.12433E+01,-0.12444E+01, + &-0.12455E+01,-0.12465E+01,-0.12476E+01,-0.12487E+01,-0.12497E+01, + &-0.12508E+01,-0.12519E+01,-0.12529E+01,-0.12540E+01,-0.12550E+01, + &-0.12561E+01,-0.12571E+01,-0.12582E+01,-0.12592E+01,-0.12603E+01, + &-0.12613E+01,-0.12624E+01,-0.12634E+01,-0.12645E+01,-0.12655E+01, + &-0.12666E+01,-0.12676E+01,-0.12687E+01,-0.12697E+01,-0.12708E+01/ + + DATA (BNC07M (I),I=401,500)/ + &-0.12718E+01,-0.12728E+01,-0.12739E+01,-0.12749E+01,-0.12759E+01, + &-0.12770E+01,-0.12780E+01,-0.12790E+01,-0.12801E+01,-0.12811E+01, + &-0.12821E+01,-0.12832E+01,-0.12842E+01,-0.12852E+01,-0.12862E+01, + &-0.12873E+01,-0.12883E+01,-0.12893E+01,-0.12903E+01,-0.12914E+01, + &-0.12924E+01,-0.12934E+01,-0.12944E+01,-0.12954E+01,-0.12964E+01, + &-0.12975E+01,-0.12985E+01,-0.12995E+01,-0.13005E+01,-0.13015E+01, + &-0.13025E+01,-0.13035E+01,-0.13045E+01,-0.13055E+01,-0.13066E+01, + &-0.13076E+01,-0.13086E+01,-0.13096E+01,-0.13106E+01,-0.13116E+01, + &-0.13126E+01,-0.13136E+01,-0.13146E+01,-0.13156E+01,-0.13166E+01, + &-0.13176E+01,-0.13186E+01,-0.13196E+01,-0.13206E+01,-0.13216E+01, + &-0.13226E+01,-0.13235E+01,-0.13245E+01,-0.13255E+01,-0.13265E+01, + &-0.13275E+01,-0.13285E+01,-0.13295E+01,-0.13305E+01,-0.13315E+01, + &-0.13324E+01,-0.13334E+01,-0.13344E+01,-0.13354E+01,-0.13364E+01, + &-0.13374E+01,-0.13383E+01,-0.13393E+01,-0.13403E+01,-0.13413E+01, + &-0.13423E+01,-0.13432E+01,-0.13442E+01,-0.13452E+01,-0.13462E+01, + &-0.13471E+01,-0.13481E+01,-0.13491E+01,-0.13500E+01,-0.13510E+01, + &-0.13520E+01,-0.13530E+01,-0.13539E+01,-0.13549E+01,-0.13559E+01, + &-0.13568E+01,-0.13578E+01,-0.13588E+01,-0.13597E+01,-0.13607E+01, + &-0.13617E+01,-0.13626E+01,-0.13636E+01,-0.13645E+01,-0.13655E+01, + &-0.13665E+01,-0.13674E+01,-0.13684E+01,-0.13693E+01,-0.13703E+01/ + + DATA (BNC07M (I),I=501,600)/ + &-0.13712E+01,-0.13722E+01,-0.13732E+01,-0.13741E+01,-0.13751E+01, + &-0.13760E+01,-0.13770E+01,-0.13779E+01,-0.13789E+01,-0.13798E+01, + &-0.13808E+01,-0.13817E+01,-0.13827E+01,-0.13836E+01,-0.13846E+01, + &-0.13855E+01,-0.13865E+01,-0.13874E+01,-0.13883E+01,-0.13893E+01, + &-0.13902E+01,-0.13912E+01,-0.13921E+01,-0.13931E+01,-0.13940E+01, + &-0.13949E+01,-0.13959E+01,-0.13968E+01,-0.13978E+01,-0.13987E+01, + &-0.13996E+01,-0.14006E+01,-0.14015E+01,-0.14024E+01,-0.14034E+01, + &-0.14043E+01,-0.14052E+01,-0.14062E+01,-0.14071E+01,-0.14080E+01, + &-0.14090E+01,-0.14099E+01,-0.14108E+01,-0.14118E+01,-0.14127E+01, + &-0.14136E+01,-0.14145E+01,-0.14155E+01,-0.14164E+01,-0.14173E+01, + &-0.14182E+01,-0.14192E+01,-0.14201E+01,-0.14210E+01,-0.14219E+01, + &-0.14229E+01,-0.14238E+01,-0.14247E+01,-0.14256E+01,-0.14265E+01, + &-0.14275E+01,-0.14284E+01,-0.14293E+01,-0.14302E+01,-0.14311E+01, + &-0.14321E+01,-0.14330E+01,-0.14339E+01,-0.14348E+01,-0.14357E+01, + &-0.14366E+01,-0.14375E+01,-0.14385E+01,-0.14394E+01,-0.14403E+01, + &-0.14412E+01,-0.14421E+01,-0.14430E+01,-0.14439E+01,-0.14448E+01, + &-0.14457E+01,-0.14467E+01,-0.14476E+01,-0.14485E+01,-0.14494E+01, + &-0.14503E+01,-0.14512E+01,-0.14521E+01,-0.14530E+01,-0.14539E+01, + &-0.14548E+01,-0.14557E+01,-0.14566E+01,-0.14575E+01,-0.14584E+01, + &-0.14593E+01,-0.14602E+01,-0.14611E+01,-0.14620E+01,-0.14654E+01/ + + DATA (BNC07M (I),I=601,700)/ + &-0.14728E+01,-0.14817E+01,-0.14906E+01,-0.14994E+01,-0.15082E+01, + &-0.15170E+01,-0.15257E+01,-0.15343E+01,-0.15430E+01,-0.15515E+01, + &-0.15601E+01,-0.15686E+01,-0.15771E+01,-0.15856E+01,-0.15940E+01, + &-0.16024E+01,-0.16107E+01,-0.16191E+01,-0.16274E+01,-0.16356E+01, + &-0.16439E+01,-0.16521E+01,-0.16603E+01,-0.16684E+01,-0.16766E+01, + &-0.16847E+01,-0.16928E+01,-0.17008E+01,-0.17089E+01,-0.17169E+01, + &-0.17249E+01,-0.17328E+01,-0.17408E+01,-0.17487E+01,-0.17566E+01, + &-0.17645E+01,-0.17723E+01,-0.17802E+01,-0.17880E+01,-0.17958E+01, + &-0.18036E+01,-0.18114E+01,-0.18191E+01,-0.18268E+01,-0.18346E+01, + &-0.18423E+01,-0.18499E+01,-0.18576E+01,-0.18652E+01,-0.18729E+01, + &-0.18805E+01,-0.18881E+01,-0.18957E+01,-0.19032E+01,-0.19108E+01, + &-0.19183E+01,-0.19258E+01,-0.19334E+01,-0.19409E+01,-0.19483E+01, + &-0.19558E+01,-0.19633E+01,-0.19707E+01,-0.19781E+01,-0.19855E+01, + &-0.19929E+01,-0.20003E+01,-0.20077E+01,-0.20151E+01,-0.20224E+01, + &-0.20298E+01,-0.20371E+01,-0.20444E+01,-0.20517E+01,-0.20590E+01, + &-0.20663E+01,-0.20736E+01,-0.20808E+01,-0.20881E+01,-0.20953E+01, + &-0.21026E+01,-0.21098E+01,-0.21170E+01,-0.21242E+01,-0.21314E+01, + &-0.21386E+01,-0.21457E+01,-0.21529E+01,-0.21601E+01,-0.21672E+01, + &-0.21743E+01,-0.21815E+01,-0.21886E+01,-0.21957E+01,-0.22028E+01, + &-0.22099E+01,-0.22169E+01,-0.22240E+01,-0.22311E+01,-0.22381E+01/ + + DATA (BNC07M(I),I=701,741)/ + &-0.22452E+01,-0.22522E+01,-0.22593E+01,-0.22663E+01,-0.22733E+01, + &-0.22803E+01,-0.22873E+01,-0.22943E+01,-0.23013E+01,-0.23082E+01, + &-0.23152E+01,-0.23222E+01,-0.23291E+01,-0.23361E+01,-0.23430E+01, + &-0.23499E+01,-0.23569E+01,-0.23638E+01,-0.23707E+01,-0.23776E+01, + &-0.23845E+01,-0.23914E+01,-0.23983E+01,-0.24052E+01,-0.24120E+01, + &-0.24189E+01,-0.24258E+01,-0.24326E+01,-0.24395E+01,-0.24463E+01, + &-0.24531E+01,-0.24600E+01,-0.24668E+01,-0.24736E+01,-0.24804E+01, + &-0.24872E+01,-0.24940E+01,-0.25008E+01,-0.25076E+01,-0.25144E+01, + &-0.25211E+01 + & / +C +C *** (H, HSO4) +C + DATA (BNC08M (I),I= 1,100)/ + &-0.50088E-01,-0.84806E-01,-0.10501E+00,-0.11624E+00,-0.12318E+00, + &-0.12753E+00,-0.13011E+00,-0.13139E+00,-0.13166E+00,-0.13112E+00, + &-0.12989E+00,-0.12809E+00,-0.12579E+00,-0.12304E+00,-0.11990E+00, + &-0.11640E+00,-0.11257E+00,-0.10844E+00,-0.10403E+00,-0.99358E-01, + &-0.94441E-01,-0.89293E-01,-0.83928E-01,-0.78356E-01,-0.72588E-01, + &-0.66634E-01,-0.60502E-01,-0.54201E-01,-0.47738E-01,-0.41119E-01, + &-0.34352E-01,-0.27443E-01,-0.20397E-01,-0.13221E-01,-0.59198E-02, + & 0.15015E-02, 0.90380E-02, 0.16685E-01, 0.24437E-01, 0.32290E-01, + & 0.40241E-01, 0.48284E-01, 0.56416E-01, 0.64634E-01, 0.72933E-01, + & 0.81310E-01, 0.89763E-01, 0.98287E-01, 0.10688E+00, 0.11554E+00, + & 0.12426E+00, 0.13304E+00, 0.14189E+00, 0.15078E+00, 0.15974E+00, + & 0.16874E+00, 0.17780E+00, 0.18691E+00, 0.19606E+00, 0.20527E+00, + & 0.21452E+00, 0.22381E+00, 0.23315E+00, 0.24254E+00, 0.25197E+00, + & 0.26144E+00, 0.27096E+00, 0.28052E+00, 0.29013E+00, 0.29978E+00, + & 0.30948E+00, 0.31922E+00, 0.32902E+00, 0.33885E+00, 0.34874E+00, + & 0.35868E+00, 0.36866E+00, 0.37870E+00, 0.38878E+00, 0.39892E+00, + & 0.40911E+00, 0.41936E+00, 0.42965E+00, 0.44000E+00, 0.45041E+00, + & 0.46087E+00, 0.47138E+00, 0.48195E+00, 0.49257E+00, 0.50325E+00, + & 0.51398E+00, 0.52476E+00, 0.53560E+00, 0.54648E+00, 0.55742E+00, + & 0.56840E+00, 0.57944E+00, 0.59052E+00, 0.60164E+00, 0.61281E+00/ + + DATA (BNC08M (I),I=101,200)/ + & 0.62402E+00, 0.63527E+00, 0.64656E+00, 0.65788E+00, 0.66924E+00, + & 0.68062E+00, 0.69204E+00, 0.70349E+00, 0.71496E+00, 0.72646E+00, + & 0.73797E+00, 0.74951E+00, 0.76106E+00, 0.77263E+00, 0.78421E+00, + & 0.79581E+00, 0.80741E+00, 0.81902E+00, 0.83063E+00, 0.84225E+00, + & 0.85289E+00, 0.86463E+00, 0.87635E+00, 0.88806E+00, 0.89976E+00, + & 0.91145E+00, 0.92312E+00, 0.93477E+00, 0.94641E+00, 0.95804E+00, + & 0.96965E+00, 0.98124E+00, 0.99282E+00, 0.10044E+01, 0.10159E+01, + & 0.10274E+01, 0.10390E+01, 0.10504E+01, 0.10619E+01, 0.10734E+01, + & 0.10848E+01, 0.10962E+01, 0.11076E+01, 0.11190E+01, 0.11303E+01, + & 0.11417E+01, 0.11530E+01, 0.11643E+01, 0.11756E+01, 0.11868E+01, + & 0.11980E+01, 0.12093E+01, 0.12204E+01, 0.12316E+01, 0.12428E+01, + & 0.12539E+01, 0.12650E+01, 0.12761E+01, 0.12871E+01, 0.12982E+01, + & 0.13092E+01, 0.13202E+01, 0.13311E+01, 0.13421E+01, 0.13530E+01, + & 0.13639E+01, 0.13748E+01, 0.13857E+01, 0.13965E+01, 0.14073E+01, + & 0.14181E+01, 0.14289E+01, 0.14396E+01, 0.14504E+01, 0.14611E+01, + & 0.14717E+01, 0.14824E+01, 0.14930E+01, 0.15036E+01, 0.15142E+01, + & 0.15248E+01, 0.15353E+01, 0.15458E+01, 0.15563E+01, 0.15668E+01, + & 0.15773E+01, 0.15877E+01, 0.15981E+01, 0.16085E+01, 0.16188E+01, + & 0.16292E+01, 0.16395E+01, 0.16498E+01, 0.16600E+01, 0.16703E+01, + & 0.16805E+01, 0.16907E+01, 0.17009E+01, 0.17110E+01, 0.17212E+01/ + + DATA (BNC08M (I),I=201,300)/ + & 0.17313E+01, 0.17414E+01, 0.17514E+01, 0.17615E+01, 0.17715E+01, + & 0.17815E+01, 0.17915E+01, 0.18014E+01, 0.18114E+01, 0.18213E+01, + & 0.18312E+01, 0.18410E+01, 0.18509E+01, 0.18607E+01, 0.18705E+01, + & 0.18803E+01, 0.18901E+01, 0.18998E+01, 0.19095E+01, 0.19192E+01, + & 0.19289E+01, 0.19385E+01, 0.19482E+01, 0.19578E+01, 0.19674E+01, + & 0.19769E+01, 0.19865E+01, 0.19960E+01, 0.20055E+01, 0.20150E+01, + & 0.20244E+01, 0.20339E+01, 0.20433E+01, 0.20527E+01, 0.20621E+01, + & 0.20715E+01, 0.20808E+01, 0.20901E+01, 0.20994E+01, 0.21087E+01, + & 0.21179E+01, 0.21272E+01, 0.21364E+01, 0.21456E+01, 0.21548E+01, + & 0.21639E+01, 0.21731E+01, 0.21822E+01, 0.21913E+01, 0.22004E+01, + & 0.22094E+01, 0.22185E+01, 0.22275E+01, 0.22365E+01, 0.22455E+01, + & 0.22545E+01, 0.22634E+01, 0.22723E+01, 0.22812E+01, 0.22901E+01, + & 0.22990E+01, 0.23078E+01, 0.23167E+01, 0.23255E+01, 0.23343E+01, + & 0.23431E+01, 0.23518E+01, 0.23606E+01, 0.23693E+01, 0.23780E+01, + & 0.23867E+01, 0.23953E+01, 0.24040E+01, 0.24126E+01, 0.24212E+01, + & 0.24298E+01, 0.24384E+01, 0.24470E+01, 0.24555E+01, 0.24640E+01, + & 0.24725E+01, 0.24810E+01, 0.24895E+01, 0.24980E+01, 0.25064E+01, + & 0.25148E+01, 0.25232E+01, 0.25316E+01, 0.25400E+01, 0.25483E+01, + & 0.25567E+01, 0.25650E+01, 0.25733E+01, 0.25816E+01, 0.25898E+01, + & 0.25981E+01, 0.26063E+01, 0.26145E+01, 0.26227E+01, 0.26309E+01/ + + DATA (BNC08M (I),I=301,400)/ + & 0.26391E+01, 0.26472E+01, 0.26554E+01, 0.26635E+01, 0.26716E+01, + & 0.26797E+01, 0.26877E+01, 0.26958E+01, 0.27038E+01, 0.27119E+01, + & 0.27199E+01, 0.27279E+01, 0.27358E+01, 0.27438E+01, 0.27517E+01, + & 0.27597E+01, 0.27676E+01, 0.27755E+01, 0.27834E+01, 0.27912E+01, + & 0.27991E+01, 0.28069E+01, 0.28148E+01, 0.28226E+01, 0.28304E+01, + & 0.28381E+01, 0.28459E+01, 0.28536E+01, 0.28614E+01, 0.28691E+01, + & 0.28768E+01, 0.28845E+01, 0.28922E+01, 0.28998E+01, 0.29075E+01, + & 0.29151E+01, 0.29227E+01, 0.29303E+01, 0.29379E+01, 0.29455E+01, + & 0.29530E+01, 0.29606E+01, 0.29681E+01, 0.29756E+01, 0.29831E+01, + & 0.29906E+01, 0.29981E+01, 0.30055E+01, 0.30130E+01, 0.30204E+01, + & 0.30278E+01, 0.30353E+01, 0.30426E+01, 0.30500E+01, 0.30574E+01, + & 0.30647E+01, 0.30721E+01, 0.30794E+01, 0.30867E+01, 0.30940E+01, + & 0.31013E+01, 0.31086E+01, 0.31158E+01, 0.31231E+01, 0.31303E+01, + & 0.31375E+01, 0.31447E+01, 0.31519E+01, 0.31591E+01, 0.31663E+01, + & 0.31734E+01, 0.31806E+01, 0.31877E+01, 0.31948E+01, 0.32019E+01, + & 0.32090E+01, 0.32161E+01, 0.32231E+01, 0.32302E+01, 0.32372E+01, + & 0.32443E+01, 0.32513E+01, 0.32583E+01, 0.32653E+01, 0.32722E+01, + & 0.32792E+01, 0.32862E+01, 0.32931E+01, 0.33000E+01, 0.33069E+01, + & 0.33139E+01, 0.33207E+01, 0.33276E+01, 0.33345E+01, 0.33414E+01, + & 0.33482E+01, 0.33550E+01, 0.33619E+01, 0.33687E+01, 0.33755E+01/ + + DATA (BNC08M (I),I=401,500)/ + & 0.33823E+01, 0.33890E+01, 0.33958E+01, 0.34026E+01, 0.34093E+01, + & 0.34160E+01, 0.34227E+01, 0.34294E+01, 0.34361E+01, 0.34428E+01, + & 0.34495E+01, 0.34562E+01, 0.34628E+01, 0.34695E+01, 0.34761E+01, + & 0.34827E+01, 0.34893E+01, 0.34959E+01, 0.35025E+01, 0.35091E+01, + & 0.35156E+01, 0.35222E+01, 0.35287E+01, 0.35352E+01, 0.35418E+01, + & 0.35483E+01, 0.35548E+01, 0.35612E+01, 0.35677E+01, 0.35742E+01, + & 0.35806E+01, 0.35871E+01, 0.35935E+01, 0.35999E+01, 0.36064E+01, + & 0.36128E+01, 0.36192E+01, 0.36255E+01, 0.36319E+01, 0.36383E+01, + & 0.36446E+01, 0.36510E+01, 0.36573E+01, 0.36636E+01, 0.36699E+01, + & 0.36762E+01, 0.36825E+01, 0.36888E+01, 0.36951E+01, 0.37013E+01, + & 0.37076E+01, 0.37138E+01, 0.37200E+01, 0.37262E+01, 0.37325E+01, + & 0.37387E+01, 0.37448E+01, 0.37510E+01, 0.37572E+01, 0.37634E+01, + & 0.37695E+01, 0.37757E+01, 0.37818E+01, 0.37879E+01, 0.37940E+01, + & 0.38001E+01, 0.38062E+01, 0.38123E+01, 0.38184E+01, 0.38244E+01, + & 0.38305E+01, 0.38365E+01, 0.38426E+01, 0.38486E+01, 0.38546E+01, + & 0.38606E+01, 0.38666E+01, 0.38726E+01, 0.38786E+01, 0.38846E+01, + & 0.38906E+01, 0.38965E+01, 0.39025E+01, 0.39084E+01, 0.39143E+01, + & 0.39202E+01, 0.39261E+01, 0.39320E+01, 0.39379E+01, 0.39438E+01, + & 0.39497E+01, 0.39556E+01, 0.39614E+01, 0.39673E+01, 0.39731E+01, + & 0.39789E+01, 0.39847E+01, 0.39906E+01, 0.39964E+01, 0.40022E+01/ + + DATA (BNC08M (I),I=501,600)/ + & 0.40079E+01, 0.40137E+01, 0.40195E+01, 0.40253E+01, 0.40310E+01, + & 0.40368E+01, 0.40425E+01, 0.40482E+01, 0.40539E+01, 0.40596E+01, + & 0.40653E+01, 0.40710E+01, 0.40767E+01, 0.40824E+01, 0.40881E+01, + & 0.40937E+01, 0.40994E+01, 0.41050E+01, 0.41107E+01, 0.41163E+01, + & 0.41219E+01, 0.41275E+01, 0.41331E+01, 0.41387E+01, 0.41443E+01, + & 0.41499E+01, 0.41554E+01, 0.41610E+01, 0.41666E+01, 0.41721E+01, + & 0.41776E+01, 0.41832E+01, 0.41887E+01, 0.41942E+01, 0.41997E+01, + & 0.42052E+01, 0.42107E+01, 0.42162E+01, 0.42217E+01, 0.42271E+01, + & 0.42326E+01, 0.42381E+01, 0.42435E+01, 0.42489E+01, 0.42544E+01, + & 0.42598E+01, 0.42652E+01, 0.42706E+01, 0.42760E+01, 0.42814E+01, + & 0.42868E+01, 0.42922E+01, 0.42975E+01, 0.43029E+01, 0.43082E+01, + & 0.43136E+01, 0.43189E+01, 0.43243E+01, 0.43296E+01, 0.43349E+01, + & 0.43402E+01, 0.43455E+01, 0.43508E+01, 0.43561E+01, 0.43614E+01, + & 0.43667E+01, 0.43719E+01, 0.43772E+01, 0.43824E+01, 0.43877E+01, + & 0.43929E+01, 0.43982E+01, 0.44034E+01, 0.44086E+01, 0.44138E+01, + & 0.44190E+01, 0.44242E+01, 0.44294E+01, 0.44346E+01, 0.44397E+01, + & 0.44449E+01, 0.44501E+01, 0.44552E+01, 0.44604E+01, 0.44655E+01, + & 0.44706E+01, 0.44758E+01, 0.44809E+01, 0.44860E+01, 0.44911E+01, + & 0.44962E+01, 0.45013E+01, 0.45064E+01, 0.45115E+01, 0.45165E+01, + & 0.45216E+01, 0.45267E+01, 0.45317E+01, 0.45368E+01, 0.45556E+01/ + + DATA (BNC08M (I),I=601,700)/ + & 0.45968E+01, 0.46461E+01, 0.46948E+01, 0.47428E+01, 0.47903E+01, + & 0.48372E+01, 0.48835E+01, 0.49293E+01, 0.49745E+01, 0.50191E+01, + & 0.50633E+01, 0.51069E+01, 0.51500E+01, 0.51927E+01, 0.52349E+01, + & 0.52765E+01, 0.53178E+01, 0.53586E+01, 0.53989E+01, 0.54388E+01, + & 0.54783E+01, 0.55174E+01, 0.55560E+01, 0.55943E+01, 0.56322E+01, + & 0.56696E+01, 0.57067E+01, 0.57435E+01, 0.57799E+01, 0.58159E+01, + & 0.58515E+01, 0.58869E+01, 0.59218E+01, 0.59565E+01, 0.59908E+01, + & 0.60248E+01, 0.60585E+01, 0.60919E+01, 0.61249E+01, 0.61577E+01, + & 0.61902E+01, 0.62224E+01, 0.62543E+01, 0.62859E+01, 0.63172E+01, + & 0.63483E+01, 0.63791E+01, 0.64096E+01, 0.64399E+01, 0.64699E+01, + & 0.64997E+01, 0.65292E+01, 0.65585E+01, 0.65875E+01, 0.66163E+01, + & 0.66449E+01, 0.66733E+01, 0.67014E+01, 0.67293E+01, 0.67569E+01, + & 0.67844E+01, 0.68116E+01, 0.68387E+01, 0.68655E+01, 0.68921E+01, + & 0.69185E+01, 0.69447E+01, 0.69707E+01, 0.69966E+01, 0.70222E+01, + & 0.70477E+01, 0.70729E+01, 0.70980E+01, 0.71229E+01, 0.71476E+01, + & 0.71721E+01, 0.71965E+01, 0.72207E+01, 0.72447E+01, 0.72686E+01, + & 0.72922E+01, 0.73158E+01, 0.73391E+01, 0.73623E+01, 0.73854E+01, + & 0.74082E+01, 0.74310E+01, 0.74536E+01, 0.74760E+01, 0.74983E+01, + & 0.75204E+01, 0.75424E+01, 0.75642E+01, 0.75859E+01, 0.76075E+01, + & 0.76289E+01, 0.76502E+01, 0.76714E+01, 0.76924E+01, 0.77132E+01/ + + DATA (BNC08M(I),I=701,741)/ + & 0.77340E+01, 0.77546E+01, 0.77751E+01, 0.77955E+01, 0.78157E+01, + & 0.78358E+01, 0.78558E+01, 0.78757E+01, 0.78955E+01, 0.79151E+01, + & 0.79346E+01, 0.79540E+01, 0.79733E+01, 0.79925E+01, 0.80115E+01, + & 0.80305E+01, 0.80493E+01, 0.80680E+01, 0.80867E+01, 0.81052E+01, + & 0.81236E+01, 0.81419E+01, 0.81601E+01, 0.81782E+01, 0.81961E+01, + & 0.82140E+01, 0.82318E+01, 0.82495E+01, 0.82671E+01, 0.82846E+01, + & 0.83020E+01, 0.83193E+01, 0.83365E+01, 0.83536E+01, 0.83706E+01, + & 0.83876E+01, 0.84044E+01, 0.84212E+01, 0.84378E+01, 0.84544E+01, + & 0.84709E+01 + & / +C +C *** NH4HSO4 +C + DATA (BNC09M (I),I= 1,100)/ + &-0.52941E-01,-0.94844E-01,-0.12343E+00,-0.14239E+00,-0.15668E+00, + &-0.16813E+00,-0.17763E+00,-0.18572E+00,-0.19272E+00,-0.19884E+00, + &-0.20425E+00,-0.20906E+00,-0.21335E+00,-0.21720E+00,-0.22065E+00, + &-0.22375E+00,-0.22654E+00,-0.22903E+00,-0.23127E+00,-0.23327E+00, + &-0.23504E+00,-0.23660E+00,-0.23797E+00,-0.23915E+00,-0.24017E+00, + &-0.24102E+00,-0.24171E+00,-0.24226E+00,-0.24267E+00,-0.24294E+00, + &-0.24309E+00,-0.24311E+00,-0.24302E+00,-0.24281E+00,-0.24250E+00, + &-0.24208E+00,-0.24156E+00,-0.24094E+00,-0.24023E+00,-0.23943E+00, + &-0.23854E+00,-0.23757E+00,-0.23652E+00,-0.23539E+00,-0.23418E+00, + &-0.23290E+00,-0.23155E+00,-0.23014E+00,-0.22866E+00,-0.22711E+00, + &-0.22551E+00,-0.22384E+00,-0.22212E+00,-0.22034E+00,-0.21851E+00, + &-0.21663E+00,-0.21470E+00,-0.21272E+00,-0.21069E+00,-0.20862E+00, + &-0.20650E+00,-0.20434E+00,-0.20214E+00,-0.19990E+00,-0.19762E+00, + &-0.19530E+00,-0.19294E+00,-0.19054E+00,-0.18811E+00,-0.18564E+00, + &-0.18314E+00,-0.18060E+00,-0.17803E+00,-0.17542E+00,-0.17278E+00, + &-0.17011E+00,-0.16741E+00,-0.16467E+00,-0.16191E+00,-0.15911E+00, + &-0.15628E+00,-0.15342E+00,-0.15053E+00,-0.14761E+00,-0.14466E+00, + &-0.14168E+00,-0.13867E+00,-0.13563E+00,-0.13256E+00,-0.12947E+00, + &-0.12635E+00,-0.12321E+00,-0.12003E+00,-0.11684E+00,-0.11361E+00, + &-0.11037E+00,-0.10710E+00,-0.10381E+00,-0.10049E+00,-0.97158E-01/ + + DATA (BNC09M (I),I=101,200)/ + &-0.93803E-01,-0.90429E-01,-0.87037E-01,-0.83628E-01,-0.80202E-01, + &-0.76760E-01,-0.73304E-01,-0.69834E-01,-0.66351E-01,-0.62857E-01, + &-0.59352E-01,-0.55836E-01,-0.52311E-01,-0.48778E-01,-0.45238E-01, + &-0.41691E-01,-0.38138E-01,-0.34580E-01,-0.31018E-01,-0.27452E-01, + &-0.24230E-01,-0.20619E-01,-0.17011E-01,-0.13406E-01,-0.98032E-02, + &-0.62041E-02,-0.26086E-02, 0.98318E-03, 0.45710E-02, 0.81547E-02, + & 0.11734E-01, 0.15308E-01, 0.18878E-01, 0.22443E-01, 0.26003E-01, + & 0.29557E-01, 0.33105E-01, 0.36648E-01, 0.40186E-01, 0.43717E-01, + & 0.47242E-01, 0.50762E-01, 0.54274E-01, 0.57781E-01, 0.61281E-01, + & 0.64774E-01, 0.68261E-01, 0.71740E-01, 0.75213E-01, 0.78679E-01, + & 0.82138E-01, 0.85590E-01, 0.89034E-01, 0.92472E-01, 0.95902E-01, + & 0.99324E-01, 0.10274E+00, 0.10615E+00, 0.10955E+00, 0.11294E+00, + & 0.11633E+00, 0.11970E+00, 0.12307E+00, 0.12643E+00, 0.12979E+00, + & 0.13314E+00, 0.13647E+00, 0.13981E+00, 0.14313E+00, 0.14644E+00, + & 0.14975E+00, 0.15305E+00, 0.15634E+00, 0.15963E+00, 0.16290E+00, + & 0.16617E+00, 0.16943E+00, 0.17268E+00, 0.17593E+00, 0.17917E+00, + & 0.18239E+00, 0.18562E+00, 0.18883E+00, 0.19203E+00, 0.19523E+00, + & 0.19842E+00, 0.20160E+00, 0.20478E+00, 0.20794E+00, 0.21110E+00, + & 0.21425E+00, 0.21739E+00, 0.22053E+00, 0.22366E+00, 0.22677E+00, + & 0.22989E+00, 0.23299E+00, 0.23609E+00, 0.23917E+00, 0.24226E+00/ + + DATA (BNC09M (I),I=201,300)/ + & 0.24533E+00, 0.24839E+00, 0.25145E+00, 0.25450E+00, 0.25755E+00, + & 0.26058E+00, 0.26361E+00, 0.26663E+00, 0.26964E+00, 0.27265E+00, + & 0.27565E+00, 0.27864E+00, 0.28162E+00, 0.28460E+00, 0.28756E+00, + & 0.29053E+00, 0.29348E+00, 0.29643E+00, 0.29937E+00, 0.30230E+00, + & 0.30522E+00, 0.30814E+00, 0.31105E+00, 0.31396E+00, 0.31685E+00, + & 0.31974E+00, 0.32263E+00, 0.32550E+00, 0.32837E+00, 0.33123E+00, + & 0.33409E+00, 0.33694E+00, 0.33978E+00, 0.34261E+00, 0.34544E+00, + & 0.34826E+00, 0.35108E+00, 0.35388E+00, 0.35668E+00, 0.35948E+00, + & 0.36227E+00, 0.36505E+00, 0.36782E+00, 0.37059E+00, 0.37335E+00, + & 0.37610E+00, 0.37885E+00, 0.38159E+00, 0.38433E+00, 0.38706E+00, + & 0.38978E+00, 0.39250E+00, 0.39521E+00, 0.39791E+00, 0.40061E+00, + & 0.40330E+00, 0.40598E+00, 0.40866E+00, 0.41133E+00, 0.41400E+00, + & 0.41666E+00, 0.41931E+00, 0.42196E+00, 0.42460E+00, 0.42724E+00, + & 0.42987E+00, 0.43249E+00, 0.43511E+00, 0.43772E+00, 0.44033E+00, + & 0.44293E+00, 0.44552E+00, 0.44811E+00, 0.45069E+00, 0.45327E+00, + & 0.45584E+00, 0.45841E+00, 0.46097E+00, 0.46352E+00, 0.46607E+00, + & 0.46861E+00, 0.47115E+00, 0.47368E+00, 0.47620E+00, 0.47872E+00, + & 0.48124E+00, 0.48375E+00, 0.48625E+00, 0.48875E+00, 0.49124E+00, + & 0.49373E+00, 0.49621E+00, 0.49869E+00, 0.50116E+00, 0.50362E+00, + & 0.50608E+00, 0.50854E+00, 0.51099E+00, 0.51343E+00, 0.51587E+00/ + + DATA (BNC09M (I),I=301,400)/ + & 0.51831E+00, 0.52073E+00, 0.52316E+00, 0.52558E+00, 0.52799E+00, + & 0.53040E+00, 0.53280E+00, 0.53520E+00, 0.53759E+00, 0.53998E+00, + & 0.54236E+00, 0.54474E+00, 0.54711E+00, 0.54948E+00, 0.55184E+00, + & 0.55420E+00, 0.55655E+00, 0.55890E+00, 0.56125E+00, 0.56358E+00, + & 0.56592E+00, 0.56825E+00, 0.57057E+00, 0.57289E+00, 0.57520E+00, + & 0.57751E+00, 0.57982E+00, 0.58212E+00, 0.58442E+00, 0.58671E+00, + & 0.58899E+00, 0.59127E+00, 0.59355E+00, 0.59582E+00, 0.59809E+00, + & 0.60036E+00, 0.60261E+00, 0.60487E+00, 0.60712E+00, 0.60936E+00, + & 0.61160E+00, 0.61384E+00, 0.61607E+00, 0.61830E+00, 0.62052E+00, + & 0.62274E+00, 0.62495E+00, 0.62716E+00, 0.62937E+00, 0.63157E+00, + & 0.63377E+00, 0.63596E+00, 0.63815E+00, 0.64033E+00, 0.64251E+00, + & 0.64469E+00, 0.64686E+00, 0.64902E+00, 0.65119E+00, 0.65334E+00, + & 0.65550E+00, 0.65765E+00, 0.65979E+00, 0.66194E+00, 0.66407E+00, + & 0.66621E+00, 0.66834E+00, 0.67046E+00, 0.67258E+00, 0.67470E+00, + & 0.67681E+00, 0.67892E+00, 0.68103E+00, 0.68313E+00, 0.68523E+00, + & 0.68732E+00, 0.68941E+00, 0.69150E+00, 0.69358E+00, 0.69565E+00, + & 0.69773E+00, 0.69980E+00, 0.70186E+00, 0.70393E+00, 0.70598E+00, + & 0.70804E+00, 0.71009E+00, 0.71214E+00, 0.71418E+00, 0.71622E+00, + & 0.71825E+00, 0.72028E+00, 0.72231E+00, 0.72434E+00, 0.72636E+00, + & 0.72837E+00, 0.73039E+00, 0.73240E+00, 0.73440E+00, 0.73640E+00/ + + DATA (BNC09M (I),I=401,500)/ + & 0.73840E+00, 0.74040E+00, 0.74239E+00, 0.74438E+00, 0.74636E+00, + & 0.74834E+00, 0.75032E+00, 0.75229E+00, 0.75426E+00, 0.75623E+00, + & 0.75819E+00, 0.76015E+00, 0.76210E+00, 0.76405E+00, 0.76600E+00, + & 0.76795E+00, 0.76989E+00, 0.77183E+00, 0.77376E+00, 0.77569E+00, + & 0.77762E+00, 0.77955E+00, 0.78147E+00, 0.78338E+00, 0.78530E+00, + & 0.78721E+00, 0.78912E+00, 0.79102E+00, 0.79292E+00, 0.79482E+00, + & 0.79671E+00, 0.79861E+00, 0.80049E+00, 0.80238E+00, 0.80426E+00, + & 0.80614E+00, 0.80801E+00, 0.80988E+00, 0.81175E+00, 0.81361E+00, + & 0.81548E+00, 0.81733E+00, 0.81919E+00, 0.82104E+00, 0.82289E+00, + & 0.82474E+00, 0.82658E+00, 0.82842E+00, 0.83025E+00, 0.83209E+00, + & 0.83392E+00, 0.83574E+00, 0.83757E+00, 0.83939E+00, 0.84121E+00, + & 0.84302E+00, 0.84483E+00, 0.84664E+00, 0.84845E+00, 0.85025E+00, + & 0.85205E+00, 0.85384E+00, 0.85564E+00, 0.85743E+00, 0.85921E+00, + & 0.86100E+00, 0.86278E+00, 0.86456E+00, 0.86633E+00, 0.86811E+00, + & 0.86988E+00, 0.87164E+00, 0.87341E+00, 0.87517E+00, 0.87692E+00, + & 0.87868E+00, 0.88043E+00, 0.88218E+00, 0.88393E+00, 0.88567E+00, + & 0.88741E+00, 0.88915E+00, 0.89088E+00, 0.89262E+00, 0.89434E+00, + & 0.89607E+00, 0.89779E+00, 0.89952E+00, 0.90123E+00, 0.90295E+00, + & 0.90466E+00, 0.90637E+00, 0.90808E+00, 0.90978E+00, 0.91148E+00, + & 0.91318E+00, 0.91488E+00, 0.91657E+00, 0.91826E+00, 0.91995E+00/ + + DATA (BNC09M (I),I=501,600)/ + & 0.92163E+00, 0.92332E+00, 0.92500E+00, 0.92667E+00, 0.92835E+00, + & 0.93002E+00, 0.93169E+00, 0.93335E+00, 0.93502E+00, 0.93668E+00, + & 0.93834E+00, 0.93999E+00, 0.94165E+00, 0.94330E+00, 0.94495E+00, + & 0.94659E+00, 0.94823E+00, 0.94987E+00, 0.95151E+00, 0.95315E+00, + & 0.95478E+00, 0.95641E+00, 0.95804E+00, 0.95966E+00, 0.96128E+00, + & 0.96290E+00, 0.96452E+00, 0.96614E+00, 0.96775E+00, 0.96936E+00, + & 0.97097E+00, 0.97257E+00, 0.97417E+00, 0.97577E+00, 0.97737E+00, + & 0.97897E+00, 0.98056E+00, 0.98215E+00, 0.98374E+00, 0.98532E+00, + & 0.98690E+00, 0.98848E+00, 0.99006E+00, 0.99164E+00, 0.99321E+00, + & 0.99478E+00, 0.99635E+00, 0.99792E+00, 0.99948E+00, 0.10010E+01, + & 0.10026E+01, 0.10042E+01, 0.10057E+01, 0.10073E+01, 0.10088E+01, + & 0.10104E+01, 0.10119E+01, 0.10134E+01, 0.10150E+01, 0.10165E+01, + & 0.10181E+01, 0.10196E+01, 0.10211E+01, 0.10227E+01, 0.10242E+01, + & 0.10257E+01, 0.10272E+01, 0.10287E+01, 0.10303E+01, 0.10318E+01, + & 0.10333E+01, 0.10348E+01, 0.10363E+01, 0.10378E+01, 0.10393E+01, + & 0.10408E+01, 0.10423E+01, 0.10438E+01, 0.10453E+01, 0.10468E+01, + & 0.10483E+01, 0.10498E+01, 0.10513E+01, 0.10528E+01, 0.10542E+01, + & 0.10557E+01, 0.10572E+01, 0.10587E+01, 0.10601E+01, 0.10616E+01, + & 0.10631E+01, 0.10646E+01, 0.10660E+01, 0.10675E+01, 0.10689E+01, + & 0.10704E+01, 0.10719E+01, 0.10733E+01, 0.10748E+01, 0.10802E+01/ + + DATA (BNC09M (I),I=601,700)/ + & 0.10920E+01, 0.11062E+01, 0.11202E+01, 0.11339E+01, 0.11475E+01, + & 0.11609E+01, 0.11741E+01, 0.11872E+01, 0.12000E+01, 0.12127E+01, + & 0.12252E+01, 0.12376E+01, 0.12498E+01, 0.12619E+01, 0.12738E+01, + & 0.12855E+01, 0.12971E+01, 0.13086E+01, 0.13199E+01, 0.13311E+01, + & 0.13421E+01, 0.13531E+01, 0.13638E+01, 0.13745E+01, 0.13850E+01, + & 0.13954E+01, 0.14057E+01, 0.14159E+01, 0.14259E+01, 0.14359E+01, + & 0.14457E+01, 0.14554E+01, 0.14650E+01, 0.14745E+01, 0.14839E+01, + & 0.14932E+01, 0.15024E+01, 0.15115E+01, 0.15205E+01, 0.15294E+01, + & 0.15382E+01, 0.15469E+01, 0.15555E+01, 0.15641E+01, 0.15725E+01, + & 0.15808E+01, 0.15891E+01, 0.15973E+01, 0.16054E+01, 0.16134E+01, + & 0.16213E+01, 0.16292E+01, 0.16370E+01, 0.16447E+01, 0.16523E+01, + & 0.16598E+01, 0.16673E+01, 0.16747E+01, 0.16820E+01, 0.16893E+01, + & 0.16965E+01, 0.17036E+01, 0.17106E+01, 0.17176E+01, 0.17245E+01, + & 0.17314E+01, 0.17381E+01, 0.17449E+01, 0.17515E+01, 0.17581E+01, + & 0.17646E+01, 0.17711E+01, 0.17775E+01, 0.17839E+01, 0.17902E+01, + & 0.17964E+01, 0.18026E+01, 0.18087E+01, 0.18148E+01, 0.18208E+01, + & 0.18268E+01, 0.18327E+01, 0.18385E+01, 0.18443E+01, 0.18501E+01, + & 0.18558E+01, 0.18614E+01, 0.18671E+01, 0.18726E+01, 0.18781E+01, + & 0.18836E+01, 0.18890E+01, 0.18943E+01, 0.18997E+01, 0.19049E+01, + & 0.19102E+01, 0.19153E+01, 0.19205E+01, 0.19256E+01, 0.19306E+01/ + + DATA (BNC09M(I),I=701,741)/ + & 0.19356E+01, 0.19406E+01, 0.19455E+01, 0.19504E+01, 0.19552E+01, + & 0.19600E+01, 0.19648E+01, 0.19695E+01, 0.19742E+01, 0.19788E+01, + & 0.19835E+01, 0.19880E+01, 0.19925E+01, 0.19970E+01, 0.20015E+01, + & 0.20059E+01, 0.20103E+01, 0.20146E+01, 0.20190E+01, 0.20232E+01, + & 0.20275E+01, 0.20317E+01, 0.20359E+01, 0.20400E+01, 0.20441E+01, + & 0.20482E+01, 0.20522E+01, 0.20562E+01, 0.20602E+01, 0.20641E+01, + & 0.20681E+01, 0.20719E+01, 0.20758E+01, 0.20796E+01, 0.20834E+01, + & 0.20872E+01, 0.20909E+01, 0.20946E+01, 0.20983E+01, 0.21019E+01, + & 0.21055E+01 + & / +C +C *** (H, NO3) +C + DATA (BNC10M (I),I= 1,100)/ + &-0.52126E-01,-0.91475E-01,-0.11662E+00,-0.13216E+00,-0.14305E+00, + &-0.15115E+00,-0.15736E+00,-0.16220E+00,-0.16600E+00,-0.16898E+00, + &-0.17131E+00,-0.17309E+00,-0.17442E+00,-0.17536E+00,-0.17597E+00, + &-0.17629E+00,-0.17637E+00,-0.17622E+00,-0.17588E+00,-0.17536E+00, + &-0.17469E+00,-0.17388E+00,-0.17294E+00,-0.17189E+00,-0.17074E+00, + &-0.16950E+00,-0.16817E+00,-0.16677E+00,-0.16530E+00,-0.16377E+00, + &-0.16218E+00,-0.16054E+00,-0.15885E+00,-0.15712E+00,-0.15535E+00, + &-0.15355E+00,-0.15172E+00,-0.14986E+00,-0.14797E+00,-0.14606E+00, + &-0.14413E+00,-0.14218E+00,-0.14022E+00,-0.13824E+00,-0.13625E+00, + &-0.13425E+00,-0.13223E+00,-0.13021E+00,-0.12818E+00,-0.12615E+00, + &-0.12410E+00,-0.12206E+00,-0.12000E+00,-0.11795E+00,-0.11588E+00, + &-0.11382E+00,-0.11175E+00,-0.10968E+00,-0.10760E+00,-0.10552E+00, + &-0.10344E+00,-0.10135E+00,-0.99254E-01,-0.97155E-01,-0.95051E-01, + &-0.92942E-01,-0.90825E-01,-0.88702E-01,-0.86572E-01,-0.84433E-01, + &-0.82285E-01,-0.80128E-01,-0.77962E-01,-0.75784E-01,-0.73596E-01, + &-0.71395E-01,-0.69182E-01,-0.66957E-01,-0.64717E-01,-0.62464E-01, + &-0.60196E-01,-0.57913E-01,-0.55615E-01,-0.53301E-01,-0.50971E-01, + &-0.48625E-01,-0.46262E-01,-0.43883E-01,-0.41487E-01,-0.39075E-01, + &-0.36646E-01,-0.34200E-01,-0.31738E-01,-0.29259E-01,-0.26764E-01, + &-0.24254E-01,-0.21728E-01,-0.19186E-01,-0.16630E-01,-0.14060E-01/ + + DATA (BNC10M (I),I=101,200)/ + &-0.11475E-01,-0.88771E-02,-0.62662E-02,-0.36428E-02,-0.10075E-02, + & 0.16391E-02, 0.42964E-02, 0.69640E-02, 0.96412E-02, 0.12327E-01, + & 0.15022E-01, 0.17725E-01, 0.20434E-01, 0.23151E-01, 0.25874E-01, + & 0.28602E-01, 0.31336E-01, 0.34074E-01, 0.36816E-01, 0.39562E-01, + & 0.41991E-01, 0.44780E-01, 0.47568E-01, 0.50354E-01, 0.53138E-01, + & 0.55921E-01, 0.58702E-01, 0.61482E-01, 0.64259E-01, 0.67035E-01, + & 0.69808E-01, 0.72580E-01, 0.75349E-01, 0.78117E-01, 0.80882E-01, + & 0.83644E-01, 0.86404E-01, 0.89162E-01, 0.91917E-01, 0.94670E-01, + & 0.97420E-01, 0.10017E+00, 0.10291E+00, 0.10565E+00, 0.10839E+00, + & 0.11113E+00, 0.11386E+00, 0.11659E+00, 0.11932E+00, 0.12205E+00, + & 0.12477E+00, 0.12749E+00, 0.13020E+00, 0.13291E+00, 0.13562E+00, + & 0.13833E+00, 0.14103E+00, 0.14373E+00, 0.14643E+00, 0.14912E+00, + & 0.15181E+00, 0.15449E+00, 0.15718E+00, 0.15985E+00, 0.16253E+00, + & 0.16520E+00, 0.16787E+00, 0.17053E+00, 0.17320E+00, 0.17585E+00, + & 0.17851E+00, 0.18116E+00, 0.18380E+00, 0.18645E+00, 0.18909E+00, + & 0.19172E+00, 0.19435E+00, 0.19698E+00, 0.19961E+00, 0.20223E+00, + & 0.20484E+00, 0.20745E+00, 0.21006E+00, 0.21267E+00, 0.21527E+00, + & 0.21787E+00, 0.22046E+00, 0.22305E+00, 0.22564E+00, 0.22822E+00, + & 0.23079E+00, 0.23337E+00, 0.23594E+00, 0.23850E+00, 0.24107E+00, + & 0.24362E+00, 0.24618E+00, 0.24873E+00, 0.25127E+00, 0.25382E+00/ + + DATA (BNC10M (I),I=201,300)/ + & 0.25635E+00, 0.25889E+00, 0.26142E+00, 0.26394E+00, 0.26647E+00, + & 0.26898E+00, 0.27150E+00, 0.27401E+00, 0.27651E+00, 0.27901E+00, + & 0.28151E+00, 0.28401E+00, 0.28649E+00, 0.28898E+00, 0.29146E+00, + & 0.29394E+00, 0.29641E+00, 0.29888E+00, 0.30135E+00, 0.30381E+00, + & 0.30626E+00, 0.30872E+00, 0.31117E+00, 0.31361E+00, 0.31605E+00, + & 0.31849E+00, 0.32092E+00, 0.32335E+00, 0.32577E+00, 0.32819E+00, + & 0.33061E+00, 0.33302E+00, 0.33543E+00, 0.33783E+00, 0.34023E+00, + & 0.34263E+00, 0.34502E+00, 0.34741E+00, 0.34979E+00, 0.35217E+00, + & 0.35455E+00, 0.35692E+00, 0.35929E+00, 0.36165E+00, 0.36401E+00, + & 0.36637E+00, 0.36872E+00, 0.37107E+00, 0.37341E+00, 0.37575E+00, + & 0.37808E+00, 0.38041E+00, 0.38274E+00, 0.38507E+00, 0.38738E+00, + & 0.38970E+00, 0.39201E+00, 0.39432E+00, 0.39662E+00, 0.39892E+00, + & 0.40122E+00, 0.40351E+00, 0.40580E+00, 0.40808E+00, 0.41036E+00, + & 0.41264E+00, 0.41491E+00, 0.41718E+00, 0.41944E+00, 0.42170E+00, + & 0.42396E+00, 0.42621E+00, 0.42846E+00, 0.43070E+00, 0.43294E+00, + & 0.43518E+00, 0.43741E+00, 0.43964E+00, 0.44186E+00, 0.44409E+00, + & 0.44630E+00, 0.44852E+00, 0.45073E+00, 0.45293E+00, 0.45513E+00, + & 0.45733E+00, 0.45953E+00, 0.46172E+00, 0.46390E+00, 0.46609E+00, + & 0.46827E+00, 0.47044E+00, 0.47261E+00, 0.47478E+00, 0.47695E+00, + & 0.47911E+00, 0.48126E+00, 0.48342E+00, 0.48556E+00, 0.48771E+00/ + + DATA (BNC10M (I),I=301,400)/ + & 0.48985E+00, 0.49199E+00, 0.49412E+00, 0.49625E+00, 0.49838E+00, + & 0.50050E+00, 0.50262E+00, 0.50474E+00, 0.50685E+00, 0.50896E+00, + & 0.51107E+00, 0.51317E+00, 0.51526E+00, 0.51736E+00, 0.51945E+00, + & 0.52154E+00, 0.52362E+00, 0.52570E+00, 0.52778E+00, 0.52985E+00, + & 0.53192E+00, 0.53398E+00, 0.53604E+00, 0.53810E+00, 0.54016E+00, + & 0.54221E+00, 0.54426E+00, 0.54630E+00, 0.54834E+00, 0.55038E+00, + & 0.55241E+00, 0.55444E+00, 0.55647E+00, 0.55849E+00, 0.56051E+00, + & 0.56253E+00, 0.56454E+00, 0.56655E+00, 0.56856E+00, 0.57056E+00, + & 0.57256E+00, 0.57455E+00, 0.57654E+00, 0.57853E+00, 0.58052E+00, + & 0.58250E+00, 0.58448E+00, 0.58645E+00, 0.58843E+00, 0.59040E+00, + & 0.59236E+00, 0.59432E+00, 0.59628E+00, 0.59824E+00, 0.60019E+00, + & 0.60214E+00, 0.60408E+00, 0.60602E+00, 0.60796E+00, 0.60990E+00, + & 0.61183E+00, 0.61376E+00, 0.61569E+00, 0.61761E+00, 0.61953E+00, + & 0.62144E+00, 0.62336E+00, 0.62527E+00, 0.62717E+00, 0.62907E+00, + & 0.63097E+00, 0.63287E+00, 0.63476E+00, 0.63666E+00, 0.63854E+00, + & 0.64043E+00, 0.64231E+00, 0.64418E+00, 0.64606E+00, 0.64793E+00, + & 0.64980E+00, 0.65166E+00, 0.65353E+00, 0.65539E+00, 0.65724E+00, + & 0.65909E+00, 0.66094E+00, 0.66279E+00, 0.66463E+00, 0.66647E+00, + & 0.66831E+00, 0.67015E+00, 0.67198E+00, 0.67381E+00, 0.67563E+00, + & 0.67745E+00, 0.67927E+00, 0.68109E+00, 0.68290E+00, 0.68471E+00/ + + DATA (BNC10M (I),I=401,500)/ + & 0.68652E+00, 0.68832E+00, 0.69013E+00, 0.69192E+00, 0.69372E+00, + & 0.69551E+00, 0.69730E+00, 0.69909E+00, 0.70087E+00, 0.70265E+00, + & 0.70443E+00, 0.70621E+00, 0.70798E+00, 0.70975E+00, 0.71151E+00, + & 0.71328E+00, 0.71504E+00, 0.71680E+00, 0.71855E+00, 0.72030E+00, + & 0.72205E+00, 0.72380E+00, 0.72554E+00, 0.72728E+00, 0.72902E+00, + & 0.73075E+00, 0.73249E+00, 0.73422E+00, 0.73594E+00, 0.73767E+00, + & 0.73939E+00, 0.74111E+00, 0.74282E+00, 0.74453E+00, 0.74624E+00, + & 0.74795E+00, 0.74966E+00, 0.75136E+00, 0.75306E+00, 0.75475E+00, + & 0.75645E+00, 0.75814E+00, 0.75983E+00, 0.76151E+00, 0.76319E+00, + & 0.76487E+00, 0.76655E+00, 0.76823E+00, 0.76990E+00, 0.77157E+00, + & 0.77324E+00, 0.77490E+00, 0.77656E+00, 0.77822E+00, 0.77988E+00, + & 0.78153E+00, 0.78318E+00, 0.78483E+00, 0.78648E+00, 0.78812E+00, + & 0.78976E+00, 0.79140E+00, 0.79303E+00, 0.79467E+00, 0.79630E+00, + & 0.79792E+00, 0.79955E+00, 0.80117E+00, 0.80279E+00, 0.80441E+00, + & 0.80603E+00, 0.80764E+00, 0.80925E+00, 0.81086E+00, 0.81246E+00, + & 0.81406E+00, 0.81566E+00, 0.81726E+00, 0.81886E+00, 0.82045E+00, + & 0.82204E+00, 0.82363E+00, 0.82521E+00, 0.82679E+00, 0.82837E+00, + & 0.82995E+00, 0.83153E+00, 0.83310E+00, 0.83467E+00, 0.83624E+00, + & 0.83781E+00, 0.83937E+00, 0.84093E+00, 0.84249E+00, 0.84405E+00, + & 0.84560E+00, 0.84715E+00, 0.84870E+00, 0.85025E+00, 0.85179E+00/ + + DATA (BNC10M (I),I=501,600)/ + & 0.85333E+00, 0.85487E+00, 0.85641E+00, 0.85794E+00, 0.85948E+00, + & 0.86101E+00, 0.86254E+00, 0.86406E+00, 0.86558E+00, 0.86711E+00, + & 0.86862E+00, 0.87014E+00, 0.87165E+00, 0.87317E+00, 0.87468E+00, + & 0.87618E+00, 0.87769E+00, 0.87919E+00, 0.88069E+00, 0.88219E+00, + & 0.88369E+00, 0.88518E+00, 0.88667E+00, 0.88816E+00, 0.88965E+00, + & 0.89113E+00, 0.89261E+00, 0.89409E+00, 0.89557E+00, 0.89705E+00, + & 0.89852E+00, 0.89999E+00, 0.90146E+00, 0.90293E+00, 0.90439E+00, + & 0.90586E+00, 0.90732E+00, 0.90878E+00, 0.91023E+00, 0.91169E+00, + & 0.91314E+00, 0.91459E+00, 0.91604E+00, 0.91748E+00, 0.91893E+00, + & 0.92037E+00, 0.92181E+00, 0.92324E+00, 0.92468E+00, 0.92611E+00, + & 0.92754E+00, 0.92897E+00, 0.93040E+00, 0.93182E+00, 0.93324E+00, + & 0.93466E+00, 0.93608E+00, 0.93750E+00, 0.93891E+00, 0.94032E+00, + & 0.94173E+00, 0.94314E+00, 0.94455E+00, 0.94595E+00, 0.94735E+00, + & 0.94875E+00, 0.95015E+00, 0.95155E+00, 0.95294E+00, 0.95433E+00, + & 0.95572E+00, 0.95711E+00, 0.95850E+00, 0.95988E+00, 0.96126E+00, + & 0.96264E+00, 0.96402E+00, 0.96539E+00, 0.96677E+00, 0.96814E+00, + & 0.96951E+00, 0.97088E+00, 0.97224E+00, 0.97361E+00, 0.97497E+00, + & 0.97633E+00, 0.97769E+00, 0.97904E+00, 0.98040E+00, 0.98175E+00, + & 0.98310E+00, 0.98445E+00, 0.98580E+00, 0.98714E+00, 0.98848E+00, + & 0.98982E+00, 0.99116E+00, 0.99250E+00, 0.99383E+00, 0.99882E+00/ + + DATA (BNC10M (I),I=601,700)/ + & 0.10097E+01, 0.10227E+01, 0.10356E+01, 0.10483E+01, 0.10608E+01, + & 0.10731E+01, 0.10852E+01, 0.10972E+01, 0.11091E+01, 0.11208E+01, + & 0.11323E+01, 0.11437E+01, 0.11549E+01, 0.11660E+01, 0.11770E+01, + & 0.11878E+01, 0.11985E+01, 0.12090E+01, 0.12195E+01, 0.12298E+01, + & 0.12399E+01, 0.12500E+01, 0.12599E+01, 0.12697E+01, 0.12794E+01, + & 0.12889E+01, 0.12984E+01, 0.13077E+01, 0.13170E+01, 0.13261E+01, + & 0.13351E+01, 0.13441E+01, 0.13529E+01, 0.13616E+01, 0.13702E+01, + & 0.13788E+01, 0.13872E+01, 0.13955E+01, 0.14038E+01, 0.14119E+01, + & 0.14200E+01, 0.14280E+01, 0.14359E+01, 0.14437E+01, 0.14514E+01, + & 0.14590E+01, 0.14666E+01, 0.14741E+01, 0.14815E+01, 0.14888E+01, + & 0.14961E+01, 0.15032E+01, 0.15103E+01, 0.15174E+01, 0.15243E+01, + & 0.15312E+01, 0.15380E+01, 0.15448E+01, 0.15515E+01, 0.15581E+01, + & 0.15646E+01, 0.15711E+01, 0.15775E+01, 0.15839E+01, 0.15901E+01, + & 0.15964E+01, 0.16025E+01, 0.16086E+01, 0.16147E+01, 0.16207E+01, + & 0.16266E+01, 0.16325E+01, 0.16383E+01, 0.16441E+01, 0.16498E+01, + & 0.16554E+01, 0.16610E+01, 0.16666E+01, 0.16721E+01, 0.16775E+01, + & 0.16829E+01, 0.16882E+01, 0.16935E+01, 0.16988E+01, 0.17040E+01, + & 0.17091E+01, 0.17142E+01, 0.17193E+01, 0.17243E+01, 0.17292E+01, + & 0.17342E+01, 0.17390E+01, 0.17439E+01, 0.17486E+01, 0.17534E+01, + & 0.17581E+01, 0.17627E+01, 0.17674E+01, 0.17719E+01, 0.17765E+01/ + + DATA (BNC10M(I),I=701,741)/ + & 0.17810E+01, 0.17854E+01, 0.17898E+01, 0.17942E+01, 0.17985E+01, + & 0.18028E+01, 0.18071E+01, 0.18113E+01, 0.18155E+01, 0.18196E+01, + & 0.18238E+01, 0.18278E+01, 0.18319E+01, 0.18359E+01, 0.18399E+01, + & 0.18438E+01, 0.18477E+01, 0.18516E+01, 0.18554E+01, 0.18592E+01, + & 0.18630E+01, 0.18667E+01, 0.18704E+01, 0.18741E+01, 0.18777E+01, + & 0.18814E+01, 0.18849E+01, 0.18885E+01, 0.18920E+01, 0.18955E+01, + & 0.18990E+01, 0.19024E+01, 0.19058E+01, 0.19092E+01, 0.19125E+01, + & 0.19158E+01, 0.19191E+01, 0.19224E+01, 0.19256E+01, 0.19288E+01, + & 0.19320E+01 + & / +C +C *** (H, Cl) +C + DATA (BNC11M (I),I= 1,100)/ + &-0.50531E-01,-0.86008E-01,-0.10676E+00,-0.11831E+00,-0.12545E+00, + &-0.12992E+00,-0.13259E+00,-0.13394E+00,-0.13429E+00,-0.13382E+00, + &-0.13270E+00,-0.13103E+00,-0.12888E+00,-0.12633E+00,-0.12342E+00, + &-0.12019E+00,-0.11668E+00,-0.11291E+00,-0.10891E+00,-0.10470E+00, + &-0.10030E+00,-0.95726E-01,-0.90985E-01,-0.86094E-01,-0.81063E-01, + &-0.75902E-01,-0.70620E-01,-0.65226E-01,-0.59728E-01,-0.54132E-01, + &-0.48445E-01,-0.42673E-01,-0.36822E-01,-0.30897E-01,-0.24903E-01, + &-0.18845E-01,-0.12727E-01,-0.65528E-02,-0.32679E-03, 0.59476E-02, + & 0.12267E-01, 0.18628E-01, 0.25028E-01, 0.31464E-01, 0.37933E-01, + & 0.44433E-01, 0.50963E-01, 0.57519E-01, 0.64099E-01, 0.70704E-01, + & 0.77329E-01, 0.83976E-01, 0.90641E-01, 0.97325E-01, 0.10403E+00, + & 0.11074E+00, 0.11748E+00, 0.12423E+00, 0.13099E+00, 0.13777E+00, + & 0.14457E+00, 0.15138E+00, 0.15821E+00, 0.16505E+00, 0.17191E+00, + & 0.17879E+00, 0.18569E+00, 0.19260E+00, 0.19954E+00, 0.20650E+00, + & 0.21347E+00, 0.22048E+00, 0.22750E+00, 0.23455E+00, 0.24163E+00, + & 0.24873E+00, 0.25587E+00, 0.26303E+00, 0.27022E+00, 0.27745E+00, + & 0.28470E+00, 0.29200E+00, 0.29932E+00, 0.30668E+00, 0.31407E+00, + & 0.32150E+00, 0.32897E+00, 0.33647E+00, 0.34402E+00, 0.35159E+00, + & 0.35921E+00, 0.36686E+00, 0.37454E+00, 0.38226E+00, 0.39002E+00, + & 0.39781E+00, 0.40564E+00, 0.41349E+00, 0.42138E+00, 0.42931E+00/ + + DATA (BNC11M (I),I=101,200)/ + & 0.43726E+00, 0.44524E+00, 0.45324E+00, 0.46128E+00, 0.46933E+00, + & 0.47741E+00, 0.48552E+00, 0.49364E+00, 0.50178E+00, 0.50994E+00, + & 0.51812E+00, 0.52631E+00, 0.53452E+00, 0.54273E+00, 0.55096E+00, + & 0.55920E+00, 0.56744E+00, 0.57570E+00, 0.58395E+00, 0.59221E+00, + & 0.59974E+00, 0.60809E+00, 0.61644E+00, 0.62477E+00, 0.63310E+00, + & 0.64142E+00, 0.64973E+00, 0.65803E+00, 0.66632E+00, 0.67461E+00, + & 0.68288E+00, 0.69114E+00, 0.69939E+00, 0.70764E+00, 0.71587E+00, + & 0.72409E+00, 0.73230E+00, 0.74050E+00, 0.74869E+00, 0.75686E+00, + & 0.76502E+00, 0.77318E+00, 0.78132E+00, 0.78944E+00, 0.79756E+00, + & 0.80566E+00, 0.81375E+00, 0.82183E+00, 0.82990E+00, 0.83795E+00, + & 0.84599E+00, 0.85401E+00, 0.86202E+00, 0.87002E+00, 0.87801E+00, + & 0.88598E+00, 0.89394E+00, 0.90188E+00, 0.90981E+00, 0.91773E+00, + & 0.92563E+00, 0.93352E+00, 0.94139E+00, 0.94925E+00, 0.95710E+00, + & 0.96493E+00, 0.97275E+00, 0.98055E+00, 0.98834E+00, 0.99611E+00, + & 0.10039E+01, 0.10116E+01, 0.10193E+01, 0.10271E+01, 0.10348E+01, + & 0.10424E+01, 0.10501E+01, 0.10578E+01, 0.10654E+01, 0.10730E+01, + & 0.10807E+01, 0.10883E+01, 0.10958E+01, 0.11034E+01, 0.11110E+01, + & 0.11185E+01, 0.11260E+01, 0.11335E+01, 0.11410E+01, 0.11485E+01, + & 0.11560E+01, 0.11634E+01, 0.11708E+01, 0.11782E+01, 0.11857E+01, + & 0.11930E+01, 0.12004E+01, 0.12078E+01, 0.12151E+01, 0.12224E+01/ + + DATA (BNC11M (I),I=201,300)/ + & 0.12298E+01, 0.12370E+01, 0.12443E+01, 0.12516E+01, 0.12589E+01, + & 0.12661E+01, 0.12733E+01, 0.12805E+01, 0.12877E+01, 0.12949E+01, + & 0.13021E+01, 0.13092E+01, 0.13163E+01, 0.13235E+01, 0.13306E+01, + & 0.13377E+01, 0.13447E+01, 0.13518E+01, 0.13588E+01, 0.13659E+01, + & 0.13729E+01, 0.13799E+01, 0.13869E+01, 0.13939E+01, 0.14008E+01, + & 0.14078E+01, 0.14147E+01, 0.14216E+01, 0.14285E+01, 0.14354E+01, + & 0.14423E+01, 0.14491E+01, 0.14560E+01, 0.14628E+01, 0.14696E+01, + & 0.14764E+01, 0.14832E+01, 0.14900E+01, 0.14968E+01, 0.15035E+01, + & 0.15103E+01, 0.15170E+01, 0.15237E+01, 0.15304E+01, 0.15370E+01, + & 0.15437E+01, 0.15504E+01, 0.15570E+01, 0.15636E+01, 0.15702E+01, + & 0.15768E+01, 0.15834E+01, 0.15900E+01, 0.15965E+01, 0.16031E+01, + & 0.16096E+01, 0.16161E+01, 0.16226E+01, 0.16291E+01, 0.16356E+01, + & 0.16421E+01, 0.16485E+01, 0.16549E+01, 0.16614E+01, 0.16678E+01, + & 0.16742E+01, 0.16806E+01, 0.16869E+01, 0.16933E+01, 0.16996E+01, + & 0.17060E+01, 0.17123E+01, 0.17186E+01, 0.17249E+01, 0.17312E+01, + & 0.17374E+01, 0.17437E+01, 0.17499E+01, 0.17562E+01, 0.17624E+01, + & 0.17686E+01, 0.17748E+01, 0.17810E+01, 0.17872E+01, 0.17933E+01, + & 0.17995E+01, 0.18056E+01, 0.18117E+01, 0.18178E+01, 0.18239E+01, + & 0.18300E+01, 0.18361E+01, 0.18421E+01, 0.18482E+01, 0.18542E+01, + & 0.18602E+01, 0.18663E+01, 0.18723E+01, 0.18783E+01, 0.18842E+01/ + + DATA (BNC11M (I),I=301,400)/ + & 0.18902E+01, 0.18962E+01, 0.19021E+01, 0.19080E+01, 0.19139E+01, + & 0.19199E+01, 0.19258E+01, 0.19316E+01, 0.19375E+01, 0.19434E+01, + & 0.19492E+01, 0.19551E+01, 0.19609E+01, 0.19667E+01, 0.19725E+01, + & 0.19783E+01, 0.19841E+01, 0.19899E+01, 0.19956E+01, 0.20014E+01, + & 0.20071E+01, 0.20129E+01, 0.20186E+01, 0.20243E+01, 0.20300E+01, + & 0.20357E+01, 0.20413E+01, 0.20470E+01, 0.20527E+01, 0.20583E+01, + & 0.20639E+01, 0.20696E+01, 0.20752E+01, 0.20808E+01, 0.20864E+01, + & 0.20919E+01, 0.20975E+01, 0.21031E+01, 0.21086E+01, 0.21142E+01, + & 0.21197E+01, 0.21252E+01, 0.21307E+01, 0.21362E+01, 0.21417E+01, + & 0.21472E+01, 0.21526E+01, 0.21581E+01, 0.21635E+01, 0.21690E+01, + & 0.21744E+01, 0.21798E+01, 0.21852E+01, 0.21906E+01, 0.21960E+01, + & 0.22014E+01, 0.22068E+01, 0.22121E+01, 0.22175E+01, 0.22228E+01, + & 0.22281E+01, 0.22335E+01, 0.22388E+01, 0.22441E+01, 0.22494E+01, + & 0.22546E+01, 0.22599E+01, 0.22652E+01, 0.22704E+01, 0.22757E+01, + & 0.22809E+01, 0.22861E+01, 0.22913E+01, 0.22965E+01, 0.23017E+01, + & 0.23069E+01, 0.23121E+01, 0.23173E+01, 0.23224E+01, 0.23276E+01, + & 0.23327E+01, 0.23379E+01, 0.23430E+01, 0.23481E+01, 0.23532E+01, + & 0.23583E+01, 0.23634E+01, 0.23685E+01, 0.23735E+01, 0.23786E+01, + & 0.23837E+01, 0.23887E+01, 0.23937E+01, 0.23988E+01, 0.24038E+01, + & 0.24088E+01, 0.24138E+01, 0.24188E+01, 0.24238E+01, 0.24288E+01/ + + DATA (BNC11M (I),I=401,500)/ + & 0.24337E+01, 0.24387E+01, 0.24436E+01, 0.24486E+01, 0.24535E+01, + & 0.24584E+01, 0.24633E+01, 0.24682E+01, 0.24731E+01, 0.24780E+01, + & 0.24829E+01, 0.24878E+01, 0.24927E+01, 0.24975E+01, 0.25024E+01, + & 0.25072E+01, 0.25120E+01, 0.25169E+01, 0.25217E+01, 0.25265E+01, + & 0.25313E+01, 0.25361E+01, 0.25409E+01, 0.25457E+01, 0.25504E+01, + & 0.25552E+01, 0.25599E+01, 0.25647E+01, 0.25694E+01, 0.25742E+01, + & 0.25789E+01, 0.25836E+01, 0.25883E+01, 0.25930E+01, 0.25977E+01, + & 0.26024E+01, 0.26071E+01, 0.26117E+01, 0.26164E+01, 0.26210E+01, + & 0.26257E+01, 0.26303E+01, 0.26350E+01, 0.26396E+01, 0.26442E+01, + & 0.26488E+01, 0.26534E+01, 0.26580E+01, 0.26626E+01, 0.26672E+01, + & 0.26717E+01, 0.26763E+01, 0.26809E+01, 0.26854E+01, 0.26900E+01, + & 0.26945E+01, 0.26990E+01, 0.27035E+01, 0.27081E+01, 0.27126E+01, + & 0.27171E+01, 0.27216E+01, 0.27260E+01, 0.27305E+01, 0.27350E+01, + & 0.27395E+01, 0.27439E+01, 0.27484E+01, 0.27528E+01, 0.27572E+01, + & 0.27617E+01, 0.27661E+01, 0.27705E+01, 0.27749E+01, 0.27793E+01, + & 0.27837E+01, 0.27881E+01, 0.27925E+01, 0.27969E+01, 0.28012E+01, + & 0.28056E+01, 0.28099E+01, 0.28143E+01, 0.28186E+01, 0.28230E+01, + & 0.28273E+01, 0.28316E+01, 0.28359E+01, 0.28402E+01, 0.28445E+01, + & 0.28488E+01, 0.28531E+01, 0.28574E+01, 0.28617E+01, 0.28660E+01, + & 0.28702E+01, 0.28745E+01, 0.28787E+01, 0.28830E+01, 0.28872E+01/ + + DATA (BNC11M (I),I=501,600)/ + & 0.28914E+01, 0.28957E+01, 0.28999E+01, 0.29041E+01, 0.29083E+01, + & 0.29125E+01, 0.29167E+01, 0.29209E+01, 0.29251E+01, 0.29292E+01, + & 0.29334E+01, 0.29376E+01, 0.29417E+01, 0.29459E+01, 0.29500E+01, + & 0.29541E+01, 0.29583E+01, 0.29624E+01, 0.29665E+01, 0.29706E+01, + & 0.29747E+01, 0.29788E+01, 0.29829E+01, 0.29870E+01, 0.29911E+01, + & 0.29952E+01, 0.29993E+01, 0.30033E+01, 0.30074E+01, 0.30114E+01, + & 0.30155E+01, 0.30195E+01, 0.30236E+01, 0.30276E+01, 0.30316E+01, + & 0.30356E+01, 0.30396E+01, 0.30437E+01, 0.30477E+01, 0.30517E+01, + & 0.30556E+01, 0.30596E+01, 0.30636E+01, 0.30676E+01, 0.30715E+01, + & 0.30755E+01, 0.30795E+01, 0.30834E+01, 0.30874E+01, 0.30913E+01, + & 0.30952E+01, 0.30992E+01, 0.31031E+01, 0.31070E+01, 0.31109E+01, + & 0.31148E+01, 0.31187E+01, 0.31226E+01, 0.31265E+01, 0.31304E+01, + & 0.31343E+01, 0.31381E+01, 0.31420E+01, 0.31459E+01, 0.31497E+01, + & 0.31536E+01, 0.31574E+01, 0.31613E+01, 0.31651E+01, 0.31689E+01, + & 0.31727E+01, 0.31766E+01, 0.31804E+01, 0.31842E+01, 0.31880E+01, + & 0.31918E+01, 0.31956E+01, 0.31994E+01, 0.32032E+01, 0.32069E+01, + & 0.32107E+01, 0.32145E+01, 0.32182E+01, 0.32220E+01, 0.32257E+01, + & 0.32295E+01, 0.32332E+01, 0.32370E+01, 0.32407E+01, 0.32444E+01, + & 0.32482E+01, 0.32519E+01, 0.32556E+01, 0.32593E+01, 0.32630E+01, + & 0.32667E+01, 0.32704E+01, 0.32741E+01, 0.32778E+01, 0.32915E+01/ + + DATA (BNC11M (I),I=601,700)/ + & 0.33216E+01, 0.33575E+01, 0.33930E+01, 0.34281E+01, 0.34627E+01, + & 0.34969E+01, 0.35306E+01, 0.35640E+01, 0.35969E+01, 0.36294E+01, + & 0.36616E+01, 0.36933E+01, 0.37247E+01, 0.37557E+01, 0.37864E+01, + & 0.38167E+01, 0.38467E+01, 0.38764E+01, 0.39057E+01, 0.39347E+01, + & 0.39633E+01, 0.39917E+01, 0.40198E+01, 0.40475E+01, 0.40750E+01, + & 0.41022E+01, 0.41291E+01, 0.41558E+01, 0.41821E+01, 0.42082E+01, + & 0.42341E+01, 0.42596E+01, 0.42850E+01, 0.43100E+01, 0.43349E+01, + & 0.43595E+01, 0.43838E+01, 0.44080E+01, 0.44319E+01, 0.44556E+01, + & 0.44790E+01, 0.45023E+01, 0.45253E+01, 0.45481E+01, 0.45707E+01, + & 0.45932E+01, 0.46154E+01, 0.46374E+01, 0.46592E+01, 0.46809E+01, + & 0.47023E+01, 0.47236E+01, 0.47447E+01, 0.47656E+01, 0.47863E+01, + & 0.48069E+01, 0.48273E+01, 0.48475E+01, 0.48675E+01, 0.48874E+01, + & 0.49071E+01, 0.49267E+01, 0.49461E+01, 0.49654E+01, 0.49845E+01, + & 0.50034E+01, 0.50222E+01, 0.50409E+01, 0.50594E+01, 0.50778E+01, + & 0.50960E+01, 0.51141E+01, 0.51321E+01, 0.51499E+01, 0.51676E+01, + & 0.51851E+01, 0.52025E+01, 0.52198E+01, 0.52370E+01, 0.52541E+01, + & 0.52710E+01, 0.52878E+01, 0.53044E+01, 0.53210E+01, 0.53374E+01, + & 0.53538E+01, 0.53700E+01, 0.53861E+01, 0.54021E+01, 0.54179E+01, + & 0.54337E+01, 0.54494E+01, 0.54649E+01, 0.54804E+01, 0.54957E+01, + & 0.55109E+01, 0.55261E+01, 0.55411E+01, 0.55560E+01, 0.55709E+01/ + + DATA (BNC11M(I),I=701,741)/ + & 0.55856E+01, 0.56002E+01, 0.56148E+01, 0.56292E+01, 0.56436E+01, + & 0.56579E+01, 0.56720E+01, 0.56861E+01, 0.57001E+01, 0.57140E+01, + & 0.57278E+01, 0.57416E+01, 0.57552E+01, 0.57688E+01, 0.57822E+01, + & 0.57956E+01, 0.58089E+01, 0.58222E+01, 0.58353E+01, 0.58484E+01, + & 0.58614E+01, 0.58743E+01, 0.58871E+01, 0.58999E+01, 0.59126E+01, + & 0.59252E+01, 0.59377E+01, 0.59501E+01, 0.59625E+01, 0.59748E+01, + & 0.59871E+01, 0.59993E+01, 0.60114E+01, 0.60234E+01, 0.60353E+01, + & 0.60472E+01, 0.60591E+01, 0.60708E+01, 0.60825E+01, 0.60941E+01, + & 0.61057E+01 + & / +C +C *** NaHSO4 +C + DATA (BNC12M (I),I= 1,100)/ + &-0.51921E-01,-0.91127E-01,-0.11645E+00,-0.13236E+00,-0.14371E+00, + &-0.15232E+00,-0.15906E+00,-0.16443E+00,-0.16876E+00,-0.17225E+00, + &-0.17506E+00,-0.17730E+00,-0.17905E+00,-0.18038E+00,-0.18133E+00, + &-0.18195E+00,-0.18227E+00,-0.18232E+00,-0.18213E+00,-0.18171E+00, + &-0.18108E+00,-0.18026E+00,-0.17926E+00,-0.17809E+00,-0.17676E+00, + &-0.17528E+00,-0.17365E+00,-0.17190E+00,-0.17001E+00,-0.16801E+00, + &-0.16589E+00,-0.16366E+00,-0.16133E+00,-0.15889E+00,-0.15636E+00, + &-0.15374E+00,-0.15103E+00,-0.14824E+00,-0.14536E+00,-0.14241E+00, + &-0.13939E+00,-0.13629E+00,-0.13313E+00,-0.12990E+00,-0.12661E+00, + &-0.12326E+00,-0.11985E+00,-0.11638E+00,-0.11286E+00,-0.10930E+00, + &-0.10568E+00,-0.10201E+00,-0.98298E-01,-0.94541E-01,-0.90742E-01, + &-0.86901E-01,-0.83019E-01,-0.79099E-01,-0.75141E-01,-0.71146E-01, + &-0.67114E-01,-0.63048E-01,-0.58946E-01,-0.54810E-01,-0.50641E-01, + &-0.46438E-01,-0.42202E-01,-0.37933E-01,-0.33632E-01,-0.29299E-01, + &-0.24933E-01,-0.20535E-01,-0.16104E-01,-0.11641E-01,-0.71452E-02, + &-0.26167E-02, 0.19444E-02, 0.65385E-02, 0.11166E-01, 0.15826E-01, + & 0.20520E-01, 0.25246E-01, 0.30007E-01, 0.34800E-01, 0.39627E-01, + & 0.44487E-01, 0.49381E-01, 0.54307E-01, 0.59265E-01, 0.64256E-01, + & 0.69279E-01, 0.74333E-01, 0.79418E-01, 0.84533E-01, 0.89677E-01, + & 0.94851E-01, 0.10005E+00, 0.10528E+00, 0.11054E+00, 0.11582E+00/ + + DATA (BNC12M (I),I=101,200)/ + & 0.12112E+00, 0.12645E+00, 0.13180E+00, 0.13717E+00, 0.14256E+00, + & 0.14797E+00, 0.15339E+00, 0.15884E+00, 0.16429E+00, 0.16977E+00, + & 0.17525E+00, 0.18075E+00, 0.18625E+00, 0.19177E+00, 0.19729E+00, + & 0.20283E+00, 0.20836E+00, 0.21391E+00, 0.21946E+00, 0.22501E+00, + & 0.23004E+00, 0.23565E+00, 0.24126E+00, 0.24687E+00, 0.25246E+00, + & 0.25805E+00, 0.26364E+00, 0.26922E+00, 0.27479E+00, 0.28035E+00, + & 0.28591E+00, 0.29146E+00, 0.29700E+00, 0.30253E+00, 0.30806E+00, + & 0.31357E+00, 0.31908E+00, 0.32458E+00, 0.33007E+00, 0.33555E+00, + & 0.34103E+00, 0.34649E+00, 0.35194E+00, 0.35739E+00, 0.36282E+00, + & 0.36825E+00, 0.37367E+00, 0.37907E+00, 0.38447E+00, 0.38985E+00, + & 0.39523E+00, 0.40060E+00, 0.40595E+00, 0.41130E+00, 0.41663E+00, + & 0.42196E+00, 0.42727E+00, 0.43257E+00, 0.43787E+00, 0.44315E+00, + & 0.44842E+00, 0.45368E+00, 0.45893E+00, 0.46417E+00, 0.46940E+00, + & 0.47462E+00, 0.47982E+00, 0.48502E+00, 0.49021E+00, 0.49538E+00, + & 0.50054E+00, 0.50570E+00, 0.51084E+00, 0.51597E+00, 0.52109E+00, + & 0.52620E+00, 0.53130E+00, 0.53638E+00, 0.54146E+00, 0.54652E+00, + & 0.55158E+00, 0.55662E+00, 0.56165E+00, 0.56668E+00, 0.57169E+00, + & 0.57669E+00, 0.58168E+00, 0.58665E+00, 0.59162E+00, 0.59658E+00, + & 0.60152E+00, 0.60646E+00, 0.61138E+00, 0.61630E+00, 0.62120E+00, + & 0.62609E+00, 0.63097E+00, 0.63584E+00, 0.64070E+00, 0.64555E+00/ + + DATA (BNC12M (I),I=201,300)/ + & 0.65039E+00, 0.65522E+00, 0.66004E+00, 0.66484E+00, 0.66964E+00, + & 0.67443E+00, 0.67920E+00, 0.68397E+00, 0.68872E+00, 0.69347E+00, + & 0.69820E+00, 0.70293E+00, 0.70764E+00, 0.71234E+00, 0.71704E+00, + & 0.72172E+00, 0.72639E+00, 0.73105E+00, 0.73571E+00, 0.74035E+00, + & 0.74498E+00, 0.74960E+00, 0.75422E+00, 0.75882E+00, 0.76341E+00, + & 0.76799E+00, 0.77257E+00, 0.77713E+00, 0.78168E+00, 0.78623E+00, + & 0.79076E+00, 0.79528E+00, 0.79980E+00, 0.80430E+00, 0.80880E+00, + & 0.81328E+00, 0.81776E+00, 0.82223E+00, 0.82668E+00, 0.83113E+00, + & 0.83557E+00, 0.84000E+00, 0.84442E+00, 0.84883E+00, 0.85323E+00, + & 0.85762E+00, 0.86200E+00, 0.86638E+00, 0.87074E+00, 0.87509E+00, + & 0.87944E+00, 0.88378E+00, 0.88810E+00, 0.89242E+00, 0.89673E+00, + & 0.90103E+00, 0.90533E+00, 0.90961E+00, 0.91388E+00, 0.91815E+00, + & 0.92240E+00, 0.92665E+00, 0.93089E+00, 0.93512E+00, 0.93934E+00, + & 0.94356E+00, 0.94776E+00, 0.95196E+00, 0.95614E+00, 0.96032E+00, + & 0.96449E+00, 0.96865E+00, 0.97281E+00, 0.97695E+00, 0.98109E+00, + & 0.98522E+00, 0.98934E+00, 0.99345E+00, 0.99755E+00, 0.10016E+01, + & 0.10057E+01, 0.10098E+01, 0.10139E+01, 0.10179E+01, 0.10220E+01, + & 0.10260E+01, 0.10301E+01, 0.10341E+01, 0.10381E+01, 0.10422E+01, + & 0.10462E+01, 0.10502E+01, 0.10541E+01, 0.10581E+01, 0.10621E+01, + & 0.10661E+01, 0.10700E+01, 0.10740E+01, 0.10779E+01, 0.10819E+01/ + + DATA (BNC12M (I),I=301,400)/ + & 0.10858E+01, 0.10897E+01, 0.10936E+01, 0.10975E+01, 0.11014E+01, + & 0.11053E+01, 0.11092E+01, 0.11131E+01, 0.11170E+01, 0.11208E+01, + & 0.11247E+01, 0.11285E+01, 0.11324E+01, 0.11362E+01, 0.11400E+01, + & 0.11438E+01, 0.11476E+01, 0.11514E+01, 0.11552E+01, 0.11590E+01, + & 0.11628E+01, 0.11666E+01, 0.11703E+01, 0.11741E+01, 0.11779E+01, + & 0.11816E+01, 0.11853E+01, 0.11891E+01, 0.11928E+01, 0.11965E+01, + & 0.12002E+01, 0.12039E+01, 0.12076E+01, 0.12113E+01, 0.12150E+01, + & 0.12187E+01, 0.12224E+01, 0.12260E+01, 0.12297E+01, 0.12333E+01, + & 0.12370E+01, 0.12406E+01, 0.12442E+01, 0.12479E+01, 0.12515E+01, + & 0.12551E+01, 0.12587E+01, 0.12623E+01, 0.12659E+01, 0.12695E+01, + & 0.12730E+01, 0.12766E+01, 0.12802E+01, 0.12837E+01, 0.12873E+01, + & 0.12908E+01, 0.12944E+01, 0.12979E+01, 0.13014E+01, 0.13050E+01, + & 0.13085E+01, 0.13120E+01, 0.13155E+01, 0.13190E+01, 0.13225E+01, + & 0.13259E+01, 0.13294E+01, 0.13329E+01, 0.13364E+01, 0.13398E+01, + & 0.13433E+01, 0.13467E+01, 0.13502E+01, 0.13536E+01, 0.13570E+01, + & 0.13604E+01, 0.13639E+01, 0.13673E+01, 0.13707E+01, 0.13741E+01, + & 0.13775E+01, 0.13809E+01, 0.13842E+01, 0.13876E+01, 0.13910E+01, + & 0.13943E+01, 0.13977E+01, 0.14011E+01, 0.14044E+01, 0.14077E+01, + & 0.14111E+01, 0.14144E+01, 0.14177E+01, 0.14210E+01, 0.14244E+01, + & 0.14277E+01, 0.14310E+01, 0.14343E+01, 0.14376E+01, 0.14408E+01/ + + DATA (BNC12M (I),I=401,500)/ + & 0.14441E+01, 0.14474E+01, 0.14507E+01, 0.14539E+01, 0.14572E+01, + & 0.14604E+01, 0.14637E+01, 0.14669E+01, 0.14701E+01, 0.14734E+01, + & 0.14766E+01, 0.14798E+01, 0.14830E+01, 0.14862E+01, 0.14894E+01, + & 0.14926E+01, 0.14958E+01, 0.14990E+01, 0.15022E+01, 0.15054E+01, + & 0.15086E+01, 0.15117E+01, 0.15149E+01, 0.15180E+01, 0.15212E+01, + & 0.15243E+01, 0.15275E+01, 0.15306E+01, 0.15337E+01, 0.15369E+01, + & 0.15400E+01, 0.15431E+01, 0.15462E+01, 0.15493E+01, 0.15524E+01, + & 0.15555E+01, 0.15586E+01, 0.15617E+01, 0.15648E+01, 0.15678E+01, + & 0.15709E+01, 0.15740E+01, 0.15770E+01, 0.15801E+01, 0.15831E+01, + & 0.15862E+01, 0.15892E+01, 0.15923E+01, 0.15953E+01, 0.15983E+01, + & 0.16014E+01, 0.16044E+01, 0.16074E+01, 0.16104E+01, 0.16134E+01, + & 0.16164E+01, 0.16194E+01, 0.16224E+01, 0.16254E+01, 0.16283E+01, + & 0.16313E+01, 0.16343E+01, 0.16372E+01, 0.16402E+01, 0.16432E+01, + & 0.16461E+01, 0.16491E+01, 0.16520E+01, 0.16549E+01, 0.16579E+01, + & 0.16608E+01, 0.16637E+01, 0.16666E+01, 0.16696E+01, 0.16725E+01, + & 0.16754E+01, 0.16783E+01, 0.16812E+01, 0.16841E+01, 0.16870E+01, + & 0.16898E+01, 0.16927E+01, 0.16956E+01, 0.16985E+01, 0.17013E+01, + & 0.17042E+01, 0.17071E+01, 0.17099E+01, 0.17128E+01, 0.17156E+01, + & 0.17185E+01, 0.17213E+01, 0.17241E+01, 0.17269E+01, 0.17298E+01, + & 0.17326E+01, 0.17354E+01, 0.17382E+01, 0.17410E+01, 0.17438E+01/ + + DATA (BNC12M (I),I=501,600)/ + & 0.17466E+01, 0.17494E+01, 0.17522E+01, 0.17550E+01, 0.17578E+01, + & 0.17606E+01, 0.17633E+01, 0.17661E+01, 0.17689E+01, 0.17716E+01, + & 0.17744E+01, 0.17771E+01, 0.17799E+01, 0.17826E+01, 0.17854E+01, + & 0.17881E+01, 0.17908E+01, 0.17936E+01, 0.17963E+01, 0.17990E+01, + & 0.18017E+01, 0.18044E+01, 0.18072E+01, 0.18099E+01, 0.18126E+01, + & 0.18153E+01, 0.18180E+01, 0.18206E+01, 0.18233E+01, 0.18260E+01, + & 0.18287E+01, 0.18314E+01, 0.18340E+01, 0.18367E+01, 0.18394E+01, + & 0.18420E+01, 0.18447E+01, 0.18473E+01, 0.18500E+01, 0.18526E+01, + & 0.18553E+01, 0.18579E+01, 0.18605E+01, 0.18632E+01, 0.18658E+01, + & 0.18684E+01, 0.18710E+01, 0.18736E+01, 0.18763E+01, 0.18789E+01, + & 0.18815E+01, 0.18841E+01, 0.18867E+01, 0.18892E+01, 0.18918E+01, + & 0.18944E+01, 0.18970E+01, 0.18996E+01, 0.19022E+01, 0.19047E+01, + & 0.19073E+01, 0.19099E+01, 0.19124E+01, 0.19150E+01, 0.19175E+01, + & 0.19201E+01, 0.19226E+01, 0.19252E+01, 0.19277E+01, 0.19302E+01, + & 0.19328E+01, 0.19353E+01, 0.19378E+01, 0.19403E+01, 0.19428E+01, + & 0.19454E+01, 0.19479E+01, 0.19504E+01, 0.19529E+01, 0.19554E+01, + & 0.19579E+01, 0.19604E+01, 0.19629E+01, 0.19653E+01, 0.19678E+01, + & 0.19703E+01, 0.19728E+01, 0.19753E+01, 0.19777E+01, 0.19802E+01, + & 0.19827E+01, 0.19851E+01, 0.19876E+01, 0.19900E+01, 0.19925E+01, + & 0.19949E+01, 0.19974E+01, 0.19998E+01, 0.20022E+01, 0.20114E+01/ + + DATA (BNC12M (I),I=601,700)/ + & 0.20312E+01, 0.20550E+01, 0.20785E+01, 0.21017E+01, 0.21246E+01, + & 0.21472E+01, 0.21695E+01, 0.21916E+01, 0.22134E+01, 0.22349E+01, + & 0.22561E+01, 0.22771E+01, 0.22978E+01, 0.23183E+01, 0.23386E+01, + & 0.23586E+01, 0.23784E+01, 0.23980E+01, 0.24173E+01, 0.24364E+01, + & 0.24553E+01, 0.24740E+01, 0.24925E+01, 0.25108E+01, 0.25289E+01, + & 0.25468E+01, 0.25646E+01, 0.25821E+01, 0.25994E+01, 0.26166E+01, + & 0.26336E+01, 0.26504E+01, 0.26670E+01, 0.26835E+01, 0.26998E+01, + & 0.27160E+01, 0.27320E+01, 0.27478E+01, 0.27635E+01, 0.27790E+01, + & 0.27943E+01, 0.28096E+01, 0.28247E+01, 0.28396E+01, 0.28544E+01, + & 0.28690E+01, 0.28836E+01, 0.28980E+01, 0.29122E+01, 0.29263E+01, + & 0.29403E+01, 0.29542E+01, 0.29680E+01, 0.29816E+01, 0.29951E+01, + & 0.30085E+01, 0.30217E+01, 0.30349E+01, 0.30479E+01, 0.30609E+01, + & 0.30737E+01, 0.30864E+01, 0.30990E+01, 0.31115E+01, 0.31239E+01, + & 0.31362E+01, 0.31483E+01, 0.31604E+01, 0.31724E+01, 0.31843E+01, + & 0.31961E+01, 0.32078E+01, 0.32194E+01, 0.32309E+01, 0.32423E+01, + & 0.32536E+01, 0.32648E+01, 0.32760E+01, 0.32870E+01, 0.32980E+01, + & 0.33089E+01, 0.33197E+01, 0.33304E+01, 0.33411E+01, 0.33516E+01, + & 0.33621E+01, 0.33725E+01, 0.33828E+01, 0.33931E+01, 0.34032E+01, + & 0.34133E+01, 0.34233E+01, 0.34333E+01, 0.34431E+01, 0.34529E+01, + & 0.34627E+01, 0.34723E+01, 0.34819E+01, 0.34914E+01, 0.35009E+01/ + + DATA (BNC12M(I),I=701,741)/ + & 0.35103E+01, 0.35196E+01, 0.35288E+01, 0.35380E+01, 0.35471E+01, + & 0.35562E+01, 0.35652E+01, 0.35741E+01, 0.35830E+01, 0.35918E+01, + & 0.36005E+01, 0.36092E+01, 0.36178E+01, 0.36264E+01, 0.36349E+01, + & 0.36434E+01, 0.36518E+01, 0.36601E+01, 0.36684E+01, 0.36766E+01, + & 0.36848E+01, 0.36929E+01, 0.37010E+01, 0.37090E+01, 0.37169E+01, + & 0.37248E+01, 0.37327E+01, 0.37405E+01, 0.37483E+01, 0.37560E+01, + & 0.37636E+01, 0.37712E+01, 0.37788E+01, 0.37863E+01, 0.37938E+01, + & 0.38012E+01, 0.38085E+01, 0.38159E+01, 0.38231E+01, 0.38304E+01, + & 0.38376E+01 + & / +C +C *** (NH4)3H(SO4)2 +C + DATA (BNC13M (I),I= 1,100)/ + &-0.86312E-01,-0.15717E+00,-0.20713E+00,-0.24120E+00,-0.26753E+00, + &-0.28912E+00,-0.30750E+00,-0.32352E+00,-0.33773E+00,-0.35052E+00, + &-0.36214E+00,-0.37278E+00,-0.38261E+00,-0.39173E+00,-0.40023E+00, + &-0.40819E+00,-0.41567E+00,-0.42272E+00,-0.42938E+00,-0.43570E+00, + &-0.44169E+00,-0.44739E+00,-0.45282E+00,-0.45800E+00,-0.46295E+00, + &-0.46769E+00,-0.47222E+00,-0.47657E+00,-0.48073E+00,-0.48473E+00, + &-0.48858E+00,-0.49227E+00,-0.49582E+00,-0.49924E+00,-0.50253E+00, + &-0.50570E+00,-0.50875E+00,-0.51169E+00,-0.51453E+00,-0.51726E+00, + &-0.51990E+00,-0.52245E+00,-0.52490E+00,-0.52727E+00,-0.52956E+00, + &-0.53177E+00,-0.53391E+00,-0.53597E+00,-0.53796E+00,-0.53988E+00, + &-0.54174E+00,-0.54353E+00,-0.54527E+00,-0.54694E+00,-0.54856E+00, + &-0.55013E+00,-0.55164E+00,-0.55310E+00,-0.55451E+00,-0.55588E+00, + &-0.55720E+00,-0.55847E+00,-0.55970E+00,-0.56089E+00,-0.56204E+00, + &-0.56315E+00,-0.56422E+00,-0.56526E+00,-0.56625E+00,-0.56722E+00, + &-0.56815E+00,-0.56904E+00,-0.56991E+00,-0.57074E+00,-0.57154E+00, + &-0.57231E+00,-0.57305E+00,-0.57377E+00,-0.57445E+00,-0.57511E+00, + &-0.57574E+00,-0.57635E+00,-0.57693E+00,-0.57748E+00,-0.57802E+00, + &-0.57852E+00,-0.57900E+00,-0.57946E+00,-0.57990E+00,-0.58032E+00, + &-0.58071E+00,-0.58108E+00,-0.58143E+00,-0.58176E+00,-0.58208E+00, + &-0.58237E+00,-0.58264E+00,-0.58290E+00,-0.58314E+00,-0.58336E+00/ + + DATA (BNC13M (I),I=101,200)/ + &-0.58356E+00,-0.58375E+00,-0.58392E+00,-0.58408E+00,-0.58422E+00, + &-0.58435E+00,-0.58447E+00,-0.58457E+00,-0.58466E+00,-0.58473E+00, + &-0.58480E+00,-0.58485E+00,-0.58489E+00,-0.58492E+00,-0.58494E+00, + &-0.58495E+00,-0.58496E+00,-0.58495E+00,-0.58493E+00,-0.58491E+00, + &-0.58498E+00,-0.58493E+00,-0.58487E+00,-0.58481E+00,-0.58474E+00, + &-0.58467E+00,-0.58459E+00,-0.58450E+00,-0.58441E+00,-0.58432E+00, + &-0.58422E+00,-0.58412E+00,-0.58401E+00,-0.58390E+00,-0.58379E+00, + &-0.58367E+00,-0.58355E+00,-0.58342E+00,-0.58330E+00,-0.58316E+00, + &-0.58303E+00,-0.58289E+00,-0.58275E+00,-0.58261E+00,-0.58246E+00, + &-0.58232E+00,-0.58217E+00,-0.58201E+00,-0.58186E+00,-0.58170E+00, + &-0.58154E+00,-0.58138E+00,-0.58122E+00,-0.58106E+00,-0.58089E+00, + &-0.58072E+00,-0.58056E+00,-0.58039E+00,-0.58021E+00,-0.58004E+00, + &-0.57987E+00,-0.57969E+00,-0.57951E+00,-0.57934E+00,-0.57916E+00, + &-0.57898E+00,-0.57880E+00,-0.57862E+00,-0.57844E+00,-0.57825E+00, + &-0.57807E+00,-0.57789E+00,-0.57770E+00,-0.57752E+00,-0.57733E+00, + &-0.57715E+00,-0.57696E+00,-0.57677E+00,-0.57658E+00,-0.57640E+00, + &-0.57621E+00,-0.57602E+00,-0.57583E+00,-0.57564E+00,-0.57546E+00, + &-0.57527E+00,-0.57508E+00,-0.57489E+00,-0.57470E+00,-0.57451E+00, + &-0.57432E+00,-0.57413E+00,-0.57394E+00,-0.57375E+00,-0.57356E+00, + &-0.57338E+00,-0.57319E+00,-0.57300E+00,-0.57281E+00,-0.57262E+00/ + + DATA (BNC13M (I),I=201,300)/ + &-0.57243E+00,-0.57225E+00,-0.57206E+00,-0.57187E+00,-0.57168E+00, + &-0.57150E+00,-0.57131E+00,-0.57112E+00,-0.57094E+00,-0.57075E+00, + &-0.57057E+00,-0.57038E+00,-0.57020E+00,-0.57002E+00,-0.56983E+00, + &-0.56965E+00,-0.56947E+00,-0.56928E+00,-0.56910E+00,-0.56892E+00, + &-0.56874E+00,-0.56856E+00,-0.56838E+00,-0.56820E+00,-0.56802E+00, + &-0.56784E+00,-0.56766E+00,-0.56749E+00,-0.56731E+00,-0.56713E+00, + &-0.56696E+00,-0.56678E+00,-0.56661E+00,-0.56643E+00,-0.56626E+00, + &-0.56609E+00,-0.56591E+00,-0.56574E+00,-0.56557E+00,-0.56540E+00, + &-0.56523E+00,-0.56506E+00,-0.56489E+00,-0.56472E+00,-0.56456E+00, + &-0.56439E+00,-0.56422E+00,-0.56406E+00,-0.56389E+00,-0.56373E+00, + &-0.56356E+00,-0.56340E+00,-0.56324E+00,-0.56308E+00,-0.56292E+00, + &-0.56276E+00,-0.56260E+00,-0.56244E+00,-0.56228E+00,-0.56212E+00, + &-0.56196E+00,-0.56181E+00,-0.56165E+00,-0.56150E+00,-0.56134E+00, + &-0.56119E+00,-0.56103E+00,-0.56088E+00,-0.56073E+00,-0.56058E+00, + &-0.56043E+00,-0.56028E+00,-0.56013E+00,-0.55998E+00,-0.55983E+00, + &-0.55969E+00,-0.55954E+00,-0.55940E+00,-0.55925E+00,-0.55911E+00, + &-0.55896E+00,-0.55882E+00,-0.55868E+00,-0.55854E+00,-0.55840E+00, + &-0.55826E+00,-0.55812E+00,-0.55798E+00,-0.55784E+00,-0.55770E+00, + &-0.55757E+00,-0.55743E+00,-0.55730E+00,-0.55716E+00,-0.55703E+00, + &-0.55690E+00,-0.55676E+00,-0.55663E+00,-0.55650E+00,-0.55637E+00/ + + DATA (BNC13M (I),I=301,400)/ + &-0.55624E+00,-0.55611E+00,-0.55599E+00,-0.55586E+00,-0.55573E+00, + &-0.55561E+00,-0.55548E+00,-0.55536E+00,-0.55523E+00,-0.55511E+00, + &-0.55499E+00,-0.55487E+00,-0.55475E+00,-0.55463E+00,-0.55451E+00, + &-0.55439E+00,-0.55427E+00,-0.55415E+00,-0.55404E+00,-0.55392E+00, + &-0.55380E+00,-0.55369E+00,-0.55358E+00,-0.55346E+00,-0.55335E+00, + &-0.55324E+00,-0.55313E+00,-0.55302E+00,-0.55291E+00,-0.55280E+00, + &-0.55269E+00,-0.55258E+00,-0.55248E+00,-0.55237E+00,-0.55226E+00, + &-0.55216E+00,-0.55206E+00,-0.55195E+00,-0.55185E+00,-0.55175E+00, + &-0.55165E+00,-0.55155E+00,-0.55145E+00,-0.55135E+00,-0.55125E+00, + &-0.55115E+00,-0.55105E+00,-0.55096E+00,-0.55086E+00,-0.55077E+00, + &-0.55067E+00,-0.55058E+00,-0.55048E+00,-0.55039E+00,-0.55030E+00, + &-0.55021E+00,-0.55012E+00,-0.55003E+00,-0.54994E+00,-0.54985E+00, + &-0.54976E+00,-0.54968E+00,-0.54959E+00,-0.54951E+00,-0.54942E+00, + &-0.54934E+00,-0.54925E+00,-0.54917E+00,-0.54909E+00,-0.54900E+00, + &-0.54892E+00,-0.54884E+00,-0.54876E+00,-0.54868E+00,-0.54861E+00, + &-0.54853E+00,-0.54845E+00,-0.54838E+00,-0.54830E+00,-0.54822E+00, + &-0.54815E+00,-0.54808E+00,-0.54800E+00,-0.54793E+00,-0.54786E+00, + &-0.54779E+00,-0.54772E+00,-0.54765E+00,-0.54758E+00,-0.54751E+00, + &-0.54744E+00,-0.54737E+00,-0.54731E+00,-0.54724E+00,-0.54717E+00, + &-0.54711E+00,-0.54705E+00,-0.54698E+00,-0.54692E+00,-0.54686E+00/ + + DATA (BNC13M (I),I=401,500)/ + &-0.54679E+00,-0.54673E+00,-0.54667E+00,-0.54661E+00,-0.54655E+00, + &-0.54650E+00,-0.54644E+00,-0.54638E+00,-0.54632E+00,-0.54627E+00, + &-0.54621E+00,-0.54616E+00,-0.54610E+00,-0.54605E+00,-0.54600E+00, + &-0.54594E+00,-0.54589E+00,-0.54584E+00,-0.54579E+00,-0.54574E+00, + &-0.54569E+00,-0.54564E+00,-0.54559E+00,-0.54555E+00,-0.54550E+00, + &-0.54545E+00,-0.54541E+00,-0.54536E+00,-0.54532E+00,-0.54527E+00, + &-0.54523E+00,-0.54519E+00,-0.54515E+00,-0.54510E+00,-0.54506E+00, + &-0.54502E+00,-0.54498E+00,-0.54494E+00,-0.54491E+00,-0.54487E+00, + &-0.54483E+00,-0.54479E+00,-0.54476E+00,-0.54472E+00,-0.54469E+00, + &-0.54465E+00,-0.54462E+00,-0.54458E+00,-0.54455E+00,-0.54452E+00, + &-0.54449E+00,-0.54446E+00,-0.54443E+00,-0.54440E+00,-0.54437E+00, + &-0.54434E+00,-0.54431E+00,-0.54428E+00,-0.54426E+00,-0.54423E+00, + &-0.54420E+00,-0.54418E+00,-0.54415E+00,-0.54413E+00,-0.54411E+00, + &-0.54408E+00,-0.54406E+00,-0.54404E+00,-0.54402E+00,-0.54400E+00, + &-0.54397E+00,-0.54395E+00,-0.54394E+00,-0.54392E+00,-0.54390E+00, + &-0.54388E+00,-0.54386E+00,-0.54385E+00,-0.54383E+00,-0.54382E+00, + &-0.54380E+00,-0.54379E+00,-0.54377E+00,-0.54376E+00,-0.54375E+00, + &-0.54373E+00,-0.54372E+00,-0.54371E+00,-0.54370E+00,-0.54369E+00, + &-0.54368E+00,-0.54367E+00,-0.54366E+00,-0.54366E+00,-0.54365E+00, + &-0.54364E+00,-0.54364E+00,-0.54363E+00,-0.54362E+00,-0.54362E+00/ + + DATA (BNC13M (I),I=501,600)/ + &-0.54362E+00,-0.54361E+00,-0.54361E+00,-0.54361E+00,-0.54360E+00, + &-0.54360E+00,-0.54360E+00,-0.54360E+00,-0.54360E+00,-0.54360E+00, + &-0.54360E+00,-0.54360E+00,-0.54360E+00,-0.54361E+00,-0.54361E+00, + &-0.54361E+00,-0.54362E+00,-0.54362E+00,-0.54363E+00,-0.54363E+00, + &-0.54364E+00,-0.54365E+00,-0.54365E+00,-0.54366E+00,-0.54367E+00, + &-0.54368E+00,-0.54369E+00,-0.54369E+00,-0.54370E+00,-0.54371E+00, + &-0.54373E+00,-0.54374E+00,-0.54375E+00,-0.54376E+00,-0.54377E+00, + &-0.54379E+00,-0.54380E+00,-0.54382E+00,-0.54383E+00,-0.54385E+00, + &-0.54386E+00,-0.54388E+00,-0.54390E+00,-0.54391E+00,-0.54393E+00, + &-0.54395E+00,-0.54397E+00,-0.54399E+00,-0.54401E+00,-0.54403E+00, + &-0.54405E+00,-0.54407E+00,-0.54409E+00,-0.54411E+00,-0.54413E+00, + &-0.54416E+00,-0.54418E+00,-0.54420E+00,-0.54423E+00,-0.54425E+00, + &-0.54428E+00,-0.54430E+00,-0.54433E+00,-0.54436E+00,-0.54438E+00, + &-0.54441E+00,-0.54444E+00,-0.54447E+00,-0.54450E+00,-0.54453E+00, + &-0.54456E+00,-0.54459E+00,-0.54462E+00,-0.54465E+00,-0.54468E+00, + &-0.54471E+00,-0.54475E+00,-0.54478E+00,-0.54481E+00,-0.54485E+00, + &-0.54488E+00,-0.54492E+00,-0.54495E+00,-0.54499E+00,-0.54502E+00, + &-0.54506E+00,-0.54510E+00,-0.54513E+00,-0.54517E+00,-0.54521E+00, + &-0.54525E+00,-0.54529E+00,-0.54533E+00,-0.54537E+00,-0.54541E+00, + &-0.54545E+00,-0.54549E+00,-0.54553E+00,-0.54558E+00,-0.54574E+00/ + + DATA (BNC13M (I),I=601,700)/ + &-0.54612E+00,-0.54661E+00,-0.54715E+00,-0.54773E+00,-0.54835E+00, + &-0.54901E+00,-0.54971E+00,-0.55044E+00,-0.55121E+00,-0.55202E+00, + &-0.55286E+00,-0.55374E+00,-0.55466E+00,-0.55560E+00,-0.55658E+00, + &-0.55760E+00,-0.55864E+00,-0.55972E+00,-0.56083E+00,-0.56196E+00, + &-0.56313E+00,-0.56433E+00,-0.56556E+00,-0.56681E+00,-0.56809E+00, + &-0.56940E+00,-0.57074E+00,-0.57210E+00,-0.57349E+00,-0.57491E+00, + &-0.57635E+00,-0.57782E+00,-0.57931E+00,-0.58082E+00,-0.58236E+00, + &-0.58392E+00,-0.58551E+00,-0.58712E+00,-0.58875E+00,-0.59040E+00, + &-0.59207E+00,-0.59377E+00,-0.59549E+00,-0.59722E+00,-0.59898E+00, + &-0.60076E+00,-0.60256E+00,-0.60438E+00,-0.60621E+00,-0.60807E+00, + &-0.60994E+00,-0.61183E+00,-0.61375E+00,-0.61567E+00,-0.61762E+00, + &-0.61959E+00,-0.62157E+00,-0.62357E+00,-0.62558E+00,-0.62761E+00, + &-0.62966E+00,-0.63173E+00,-0.63381E+00,-0.63590E+00,-0.63801E+00, + &-0.64014E+00,-0.64228E+00,-0.64444E+00,-0.64661E+00,-0.64879E+00, + &-0.65099E+00,-0.65321E+00,-0.65544E+00,-0.65768E+00,-0.65993E+00, + &-0.66220E+00,-0.66448E+00,-0.66678E+00,-0.66909E+00,-0.67141E+00, + &-0.67374E+00,-0.67609E+00,-0.67845E+00,-0.68082E+00,-0.68320E+00, + &-0.68560E+00,-0.68800E+00,-0.69042E+00,-0.69285E+00,-0.69529E+00, + &-0.69774E+00,-0.70021E+00,-0.70268E+00,-0.70516E+00,-0.70766E+00, + &-0.71017E+00,-0.71268E+00,-0.71521E+00,-0.71775E+00,-0.72030E+00/ + + DATA (BNC13M(I),I=701,741)/ + &-0.72285E+00,-0.72542E+00,-0.72800E+00,-0.73059E+00,-0.73318E+00, + &-0.73579E+00,-0.73840E+00,-0.74103E+00,-0.74366E+00,-0.74631E+00, + &-0.74896E+00,-0.75162E+00,-0.75429E+00,-0.75697E+00,-0.75966E+00, + &-0.76235E+00,-0.76505E+00,-0.76777E+00,-0.77049E+00,-0.77322E+00, + &-0.77595E+00,-0.77870E+00,-0.78145E+00,-0.78421E+00,-0.78698E+00, + &-0.78976E+00,-0.79254E+00,-0.79534E+00,-0.79814E+00,-0.80094E+00, + &-0.80376E+00,-0.80658E+00,-0.80941E+00,-0.81224E+00,-0.81509E+00, + &-0.81794E+00,-0.82079E+00,-0.82366E+00,-0.82653E+00,-0.82940E+00, + &-0.83229E+00 + & / + END + +C *** TEMP = 273.0 + + BLOCK DATA KMCF273 +C +C *** Common block definition +C + COMMON /KMC273/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) +C +C *** NaCl +C + DATA (BNC01M (I),I= 1,100)/ + &-0.51181E-01,-0.90341E-01,-0.11577E+00,-0.13175E+00,-0.14316E+00, + &-0.15182E+00,-0.15860E+00,-0.16404E+00,-0.16845E+00,-0.17205E+00, + &-0.17501E+00,-0.17742E+00,-0.17939E+00,-0.18097E+00,-0.18222E+00, + &-0.18320E+00,-0.18392E+00,-0.18442E+00,-0.18473E+00,-0.18487E+00, + &-0.18485E+00,-0.18470E+00,-0.18442E+00,-0.18402E+00,-0.18353E+00, + &-0.18294E+00,-0.18227E+00,-0.18153E+00,-0.18071E+00,-0.17983E+00, + &-0.17889E+00,-0.17790E+00,-0.17686E+00,-0.17578E+00,-0.17466E+00, + &-0.17350E+00,-0.17231E+00,-0.17109E+00,-0.16984E+00,-0.16856E+00, + &-0.16726E+00,-0.16594E+00,-0.16461E+00,-0.16325E+00,-0.16188E+00, + &-0.16050E+00,-0.15910E+00,-0.15769E+00,-0.15627E+00,-0.15484E+00, + &-0.15340E+00,-0.15196E+00,-0.15050E+00,-0.14904E+00,-0.14757E+00, + &-0.14610E+00,-0.14462E+00,-0.14313E+00,-0.14164E+00,-0.14014E+00, + &-0.13863E+00,-0.13712E+00,-0.13560E+00,-0.13408E+00,-0.13255E+00, + &-0.13101E+00,-0.12947E+00,-0.12792E+00,-0.12636E+00,-0.12479E+00, + &-0.12321E+00,-0.12163E+00,-0.12003E+00,-0.11843E+00,-0.11681E+00, + &-0.11518E+00,-0.11355E+00,-0.11189E+00,-0.11023E+00,-0.10856E+00, + &-0.10687E+00,-0.10517E+00,-0.10346E+00,-0.10173E+00,-0.99989E-01, + &-0.98234E-01,-0.96465E-01,-0.94683E-01,-0.92886E-01,-0.91075E-01, + &-0.89250E-01,-0.87411E-01,-0.85558E-01,-0.83692E-01,-0.81812E-01, + &-0.79919E-01,-0.78013E-01,-0.76094E-01,-0.74163E-01,-0.72220E-01/ + + DATA (BNC01M (I),I=101,200)/ + &-0.70265E-01,-0.68299E-01,-0.66323E-01,-0.64335E-01,-0.62338E-01, + &-0.60331E-01,-0.58315E-01,-0.56291E-01,-0.54258E-01,-0.52218E-01, + &-0.50171E-01,-0.48116E-01,-0.46056E-01,-0.43989E-01,-0.41917E-01, + &-0.39840E-01,-0.37759E-01,-0.35673E-01,-0.33583E-01,-0.31490E-01, + &-0.29641E-01,-0.27514E-01,-0.25387E-01,-0.23261E-01,-0.21135E-01, + &-0.19010E-01,-0.16886E-01,-0.14763E-01,-0.12640E-01,-0.10519E-01, + &-0.83981E-02,-0.62786E-02,-0.41603E-02,-0.20431E-02, 0.72873E-04, + & 0.21874E-02, 0.43007E-02, 0.64126E-02, 0.85231E-02, 0.10632E-01, + & 0.12740E-01, 0.14845E-01, 0.16950E-01, 0.19052E-01, 0.21153E-01, + & 0.23252E-01, 0.25350E-01, 0.27446E-01, 0.29539E-01, 0.31631E-01, + & 0.33721E-01, 0.35809E-01, 0.37895E-01, 0.39979E-01, 0.42061E-01, + & 0.44141E-01, 0.46219E-01, 0.48295E-01, 0.50369E-01, 0.52440E-01, + & 0.54509E-01, 0.56576E-01, 0.58641E-01, 0.60703E-01, 0.62764E-01, + & 0.64821E-01, 0.66877E-01, 0.68930E-01, 0.70981E-01, 0.73029E-01, + & 0.75075E-01, 0.77119E-01, 0.79160E-01, 0.81199E-01, 0.83235E-01, + & 0.85268E-01, 0.87299E-01, 0.89328E-01, 0.91354E-01, 0.93378E-01, + & 0.95399E-01, 0.97417E-01, 0.99433E-01, 0.10145E+00, 0.10346E+00, + & 0.10546E+00, 0.10747E+00, 0.10947E+00, 0.11147E+00, 0.11347E+00, + & 0.11546E+00, 0.11746E+00, 0.11944E+00, 0.12143E+00, 0.12341E+00, + & 0.12540E+00, 0.12737E+00, 0.12935E+00, 0.13132E+00, 0.13329E+00/ + + DATA (BNC01M (I),I=201,300)/ + & 0.13526E+00, 0.13722E+00, 0.13919E+00, 0.14114E+00, 0.14310E+00, + & 0.14505E+00, 0.14700E+00, 0.14895E+00, 0.15090E+00, 0.15284E+00, + & 0.15478E+00, 0.15671E+00, 0.15865E+00, 0.16058E+00, 0.16251E+00, + & 0.16443E+00, 0.16635E+00, 0.16827E+00, 0.17019E+00, 0.17210E+00, + & 0.17402E+00, 0.17592E+00, 0.17783E+00, 0.17973E+00, 0.18163E+00, + & 0.18353E+00, 0.18542E+00, 0.18731E+00, 0.18920E+00, 0.19109E+00, + & 0.19297E+00, 0.19485E+00, 0.19672E+00, 0.19860E+00, 0.20047E+00, + & 0.20234E+00, 0.20420E+00, 0.20606E+00, 0.20792E+00, 0.20978E+00, + & 0.21164E+00, 0.21349E+00, 0.21533E+00, 0.21718E+00, 0.21902E+00, + & 0.22086E+00, 0.22270E+00, 0.22453E+00, 0.22636E+00, 0.22819E+00, + & 0.23002E+00, 0.23184E+00, 0.23366E+00, 0.23548E+00, 0.23729E+00, + & 0.23910E+00, 0.24091E+00, 0.24272E+00, 0.24452E+00, 0.24632E+00, + & 0.24812E+00, 0.24991E+00, 0.25170E+00, 0.25349E+00, 0.25528E+00, + & 0.25706E+00, 0.25884E+00, 0.26062E+00, 0.26239E+00, 0.26417E+00, + & 0.26594E+00, 0.26770E+00, 0.26947E+00, 0.27123E+00, 0.27299E+00, + & 0.27474E+00, 0.27649E+00, 0.27824E+00, 0.27999E+00, 0.28173E+00, + & 0.28348E+00, 0.28522E+00, 0.28695E+00, 0.28869E+00, 0.29042E+00, + & 0.29214E+00, 0.29387E+00, 0.29559E+00, 0.29731E+00, 0.29903E+00, + & 0.30074E+00, 0.30245E+00, 0.30416E+00, 0.30587E+00, 0.30757E+00, + & 0.30927E+00, 0.31097E+00, 0.31267E+00, 0.31436E+00, 0.31605E+00/ + + DATA (BNC01M (I),I=301,400)/ + & 0.31774E+00, 0.31942E+00, 0.32111E+00, 0.32279E+00, 0.32446E+00, + & 0.32614E+00, 0.32781E+00, 0.32948E+00, 0.33115E+00, 0.33281E+00, + & 0.33447E+00, 0.33613E+00, 0.33779E+00, 0.33944E+00, 0.34109E+00, + & 0.34274E+00, 0.34438E+00, 0.34603E+00, 0.34767E+00, 0.34930E+00, + & 0.35094E+00, 0.35257E+00, 0.35420E+00, 0.35583E+00, 0.35746E+00, + & 0.35908E+00, 0.36070E+00, 0.36232E+00, 0.36393E+00, 0.36554E+00, + & 0.36715E+00, 0.36876E+00, 0.37037E+00, 0.37197E+00, 0.37357E+00, + & 0.37517E+00, 0.37676E+00, 0.37835E+00, 0.37994E+00, 0.38153E+00, + & 0.38312E+00, 0.38470E+00, 0.38628E+00, 0.38786E+00, 0.38943E+00, + & 0.39100E+00, 0.39257E+00, 0.39414E+00, 0.39571E+00, 0.39727E+00, + & 0.39883E+00, 0.40039E+00, 0.40195E+00, 0.40350E+00, 0.40505E+00, + & 0.40660E+00, 0.40814E+00, 0.40969E+00, 0.41123E+00, 0.41277E+00, + & 0.41431E+00, 0.41584E+00, 0.41737E+00, 0.41890E+00, 0.42043E+00, + & 0.42195E+00, 0.42348E+00, 0.42500E+00, 0.42651E+00, 0.42803E+00, + & 0.42954E+00, 0.43105E+00, 0.43256E+00, 0.43407E+00, 0.43557E+00, + & 0.43707E+00, 0.43857E+00, 0.44007E+00, 0.44157E+00, 0.44306E+00, + & 0.44455E+00, 0.44604E+00, 0.44752E+00, 0.44901E+00, 0.45049E+00, + & 0.45197E+00, 0.45344E+00, 0.45492E+00, 0.45639E+00, 0.45786E+00, + & 0.45933E+00, 0.46079E+00, 0.46226E+00, 0.46372E+00, 0.46518E+00, + & 0.46664E+00, 0.46809E+00, 0.46954E+00, 0.47099E+00, 0.47244E+00/ + + DATA (BNC01M (I),I=401,500)/ + & 0.47389E+00, 0.47533E+00, 0.47677E+00, 0.47821E+00, 0.47965E+00, + & 0.48108E+00, 0.48252E+00, 0.48395E+00, 0.48538E+00, 0.48680E+00, + & 0.48823E+00, 0.48965E+00, 0.49107E+00, 0.49249E+00, 0.49391E+00, + & 0.49532E+00, 0.49673E+00, 0.49814E+00, 0.49955E+00, 0.50095E+00, + & 0.50236E+00, 0.50376E+00, 0.50516E+00, 0.50656E+00, 0.50795E+00, + & 0.50934E+00, 0.51074E+00, 0.51213E+00, 0.51351E+00, 0.51490E+00, + & 0.51628E+00, 0.51766E+00, 0.51904E+00, 0.52042E+00, 0.52179E+00, + & 0.52317E+00, 0.52454E+00, 0.52591E+00, 0.52727E+00, 0.52864E+00, + & 0.53000E+00, 0.53136E+00, 0.53272E+00, 0.53408E+00, 0.53543E+00, + & 0.53678E+00, 0.53814E+00, 0.53949E+00, 0.54083E+00, 0.54218E+00, + & 0.54352E+00, 0.54486E+00, 0.54620E+00, 0.54754E+00, 0.54888E+00, + & 0.55021E+00, 0.55154E+00, 0.55287E+00, 0.55420E+00, 0.55552E+00, + & 0.55685E+00, 0.55817E+00, 0.55949E+00, 0.56081E+00, 0.56213E+00, + & 0.56344E+00, 0.56475E+00, 0.56606E+00, 0.56737E+00, 0.56868E+00, + & 0.56999E+00, 0.57129E+00, 0.57259E+00, 0.57389E+00, 0.57519E+00, + & 0.57649E+00, 0.57778E+00, 0.57907E+00, 0.58036E+00, 0.58165E+00, + & 0.58294E+00, 0.58422E+00, 0.58551E+00, 0.58679E+00, 0.58807E+00, + & 0.58935E+00, 0.59062E+00, 0.59190E+00, 0.59317E+00, 0.59444E+00, + & 0.59571E+00, 0.59698E+00, 0.59824E+00, 0.59951E+00, 0.60077E+00, + & 0.60203E+00, 0.60329E+00, 0.60454E+00, 0.60580E+00, 0.60705E+00/ + + DATA (BNC01M (I),I=501,600)/ + & 0.60830E+00, 0.60955E+00, 0.61080E+00, 0.61205E+00, 0.61329E+00, + & 0.61454E+00, 0.61578E+00, 0.61702E+00, 0.61825E+00, 0.61949E+00, + & 0.62072E+00, 0.62196E+00, 0.62319E+00, 0.62442E+00, 0.62565E+00, + & 0.62687E+00, 0.62810E+00, 0.62932E+00, 0.63054E+00, 0.63176E+00, + & 0.63298E+00, 0.63419E+00, 0.63541E+00, 0.63662E+00, 0.63783E+00, + & 0.63904E+00, 0.64025E+00, 0.64145E+00, 0.64266E+00, 0.64386E+00, + & 0.64506E+00, 0.64626E+00, 0.64746E+00, 0.64866E+00, 0.64985E+00, + & 0.65104E+00, 0.65223E+00, 0.65342E+00, 0.65461E+00, 0.65580E+00, + & 0.65698E+00, 0.65817E+00, 0.65935E+00, 0.66053E+00, 0.66171E+00, + & 0.66289E+00, 0.66406E+00, 0.66524E+00, 0.66641E+00, 0.66758E+00, + & 0.66875E+00, 0.66992E+00, 0.67108E+00, 0.67225E+00, 0.67341E+00, + & 0.67457E+00, 0.67573E+00, 0.67689E+00, 0.67805E+00, 0.67920E+00, + & 0.68036E+00, 0.68151E+00, 0.68266E+00, 0.68381E+00, 0.68496E+00, + & 0.68610E+00, 0.68725E+00, 0.68839E+00, 0.68953E+00, 0.69068E+00, + & 0.69181E+00, 0.69295E+00, 0.69409E+00, 0.69522E+00, 0.69636E+00, + & 0.69749E+00, 0.69862E+00, 0.69975E+00, 0.70087E+00, 0.70200E+00, + & 0.70312E+00, 0.70425E+00, 0.70537E+00, 0.70649E+00, 0.70760E+00, + & 0.70872E+00, 0.70984E+00, 0.71095E+00, 0.71206E+00, 0.71317E+00, + & 0.71428E+00, 0.71539E+00, 0.71650E+00, 0.71761E+00, 0.71871E+00, + & 0.71981E+00, 0.72091E+00, 0.72201E+00, 0.72311E+00, 0.72722E+00/ + + DATA (BNC01M (I),I=601,700)/ + & 0.73618E+00, 0.74693E+00, 0.75754E+00, 0.76801E+00, 0.77836E+00, + & 0.78859E+00, 0.79869E+00, 0.80867E+00, 0.81853E+00, 0.82827E+00, + & 0.83790E+00, 0.84742E+00, 0.85682E+00, 0.86613E+00, 0.87532E+00, + & 0.88441E+00, 0.89340E+00, 0.90229E+00, 0.91108E+00, 0.91978E+00, + & 0.92838E+00, 0.93688E+00, 0.94530E+00, 0.95363E+00, 0.96187E+00, + & 0.97002E+00, 0.97808E+00, 0.98607E+00, 0.99397E+00, 0.10018E+01, + & 0.10095E+01, 0.10172E+01, 0.10248E+01, 0.10323E+01, 0.10397E+01, + & 0.10471E+01, 0.10544E+01, 0.10616E+01, 0.10688E+01, 0.10758E+01, + & 0.10828E+01, 0.10898E+01, 0.10967E+01, 0.11035E+01, 0.11102E+01, + & 0.11169E+01, 0.11236E+01, 0.11301E+01, 0.11366E+01, 0.11431E+01, + & 0.11495E+01, 0.11558E+01, 0.11621E+01, 0.11683E+01, 0.11745E+01, + & 0.11806E+01, 0.11867E+01, 0.11927E+01, 0.11986E+01, 0.12045E+01, + & 0.12104E+01, 0.12162E+01, 0.12220E+01, 0.12277E+01, 0.12333E+01, + & 0.12389E+01, 0.12445E+01, 0.12500E+01, 0.12555E+01, 0.12609E+01, + & 0.12663E+01, 0.12717E+01, 0.12770E+01, 0.12822E+01, 0.12874E+01, + & 0.12926E+01, 0.12977E+01, 0.13028E+01, 0.13079E+01, 0.13129E+01, + & 0.13179E+01, 0.13228E+01, 0.13277E+01, 0.13325E+01, 0.13374E+01, + & 0.13421E+01, 0.13469E+01, 0.13516E+01, 0.13563E+01, 0.13609E+01, + & 0.13655E+01, 0.13701E+01, 0.13746E+01, 0.13792E+01, 0.13836E+01, + & 0.13881E+01, 0.13925E+01, 0.13968E+01, 0.14012E+01, 0.14055E+01/ + + DATA (BNC01M(I),I=701,741)/ + & 0.14098E+01, 0.14140E+01, 0.14183E+01, 0.14224E+01, 0.14266E+01, + & 0.14307E+01, 0.14348E+01, 0.14389E+01, 0.14430E+01, 0.14470E+01, + & 0.14510E+01, 0.14549E+01, 0.14589E+01, 0.14628E+01, 0.14666E+01, + & 0.14705E+01, 0.14743E+01, 0.14781E+01, 0.14819E+01, 0.14856E+01, + & 0.14894E+01, 0.14931E+01, 0.14967E+01, 0.15004E+01, 0.15040E+01, + & 0.15076E+01, 0.15112E+01, 0.15147E+01, 0.15183E+01, 0.15218E+01, + & 0.15253E+01, 0.15287E+01, 0.15322E+01, 0.15356E+01, 0.15390E+01, + & 0.15424E+01, 0.15457E+01, 0.15490E+01, 0.15524E+01, 0.15556E+01, + & 0.15589E+01 + & / +C +C *** Na2SO4 +C + DATA (BNC02M (I),I= 1,100)/ + &-0.10572E+00,-0.19298E+00,-0.25472E+00,-0.29692E+00,-0.32958E+00, + &-0.35641E+00,-0.37928E+00,-0.39926E+00,-0.41702E+00,-0.43303E+00, + &-0.44762E+00,-0.46103E+00,-0.47344E+00,-0.48500E+00,-0.49582E+00, + &-0.50599E+00,-0.51560E+00,-0.52470E+00,-0.53334E+00,-0.54158E+00, + &-0.54945E+00,-0.55698E+00,-0.56420E+00,-0.57114E+00,-0.57782E+00, + &-0.58426E+00,-0.59048E+00,-0.59649E+00,-0.60231E+00,-0.60795E+00, + &-0.61341E+00,-0.61872E+00,-0.62388E+00,-0.62890E+00,-0.63378E+00, + &-0.63854E+00,-0.64318E+00,-0.64771E+00,-0.65213E+00,-0.65644E+00, + &-0.66066E+00,-0.66479E+00,-0.66882E+00,-0.67278E+00,-0.67665E+00, + &-0.68044E+00,-0.68416E+00,-0.68780E+00,-0.69138E+00,-0.69489E+00, + &-0.69834E+00,-0.70173E+00,-0.70505E+00,-0.70833E+00,-0.71154E+00, + &-0.71471E+00,-0.71782E+00,-0.72089E+00,-0.72391E+00,-0.72688E+00, + &-0.72981E+00,-0.73269E+00,-0.73554E+00,-0.73834E+00,-0.74111E+00, + &-0.74384E+00,-0.74654E+00,-0.74920E+00,-0.75183E+00,-0.75442E+00, + &-0.75698E+00,-0.75952E+00,-0.76202E+00,-0.76450E+00,-0.76695E+00, + &-0.76937E+00,-0.77176E+00,-0.77414E+00,-0.77648E+00,-0.77881E+00, + &-0.78111E+00,-0.78339E+00,-0.78564E+00,-0.78788E+00,-0.79010E+00, + &-0.79229E+00,-0.79447E+00,-0.79663E+00,-0.79877E+00,-0.80090E+00, + &-0.80300E+00,-0.80509E+00,-0.80717E+00,-0.80922E+00,-0.81127E+00, + &-0.81329E+00,-0.81530E+00,-0.81730E+00,-0.81928E+00,-0.82125E+00/ + + DATA (BNC02M (I),I=101,200)/ + &-0.82321E+00,-0.82515E+00,-0.82707E+00,-0.82899E+00,-0.83089E+00, + &-0.83278E+00,-0.83466E+00,-0.83652E+00,-0.83837E+00,-0.84021E+00, + &-0.84204E+00,-0.84386E+00,-0.84566E+00,-0.84746E+00,-0.84924E+00, + &-0.85101E+00,-0.85277E+00,-0.85452E+00,-0.85626E+00,-0.85799E+00, + &-0.85967E+00,-0.86138E+00,-0.86309E+00,-0.86478E+00,-0.86646E+00, + &-0.86813E+00,-0.86980E+00,-0.87145E+00,-0.87309E+00,-0.87473E+00, + &-0.87635E+00,-0.87797E+00,-0.87957E+00,-0.88117E+00,-0.88276E+00, + &-0.88434E+00,-0.88591E+00,-0.88747E+00,-0.88902E+00,-0.89057E+00, + &-0.89211E+00,-0.89364E+00,-0.89516E+00,-0.89667E+00,-0.89818E+00, + &-0.89968E+00,-0.90117E+00,-0.90266E+00,-0.90413E+00,-0.90560E+00, + &-0.90707E+00,-0.90852E+00,-0.90997E+00,-0.91141E+00,-0.91285E+00, + &-0.91428E+00,-0.91570E+00,-0.91711E+00,-0.91852E+00,-0.91992E+00, + &-0.92132E+00,-0.92271E+00,-0.92410E+00,-0.92547E+00,-0.92685E+00, + &-0.92821E+00,-0.92957E+00,-0.93093E+00,-0.93228E+00,-0.93362E+00, + &-0.93496E+00,-0.93629E+00,-0.93761E+00,-0.93894E+00,-0.94025E+00, + &-0.94156E+00,-0.94287E+00,-0.94417E+00,-0.94546E+00,-0.94675E+00, + &-0.94804E+00,-0.94932E+00,-0.95059E+00,-0.95186E+00,-0.95313E+00, + &-0.95439E+00,-0.95565E+00,-0.95690E+00,-0.95815E+00,-0.95939E+00, + &-0.96063E+00,-0.96186E+00,-0.96309E+00,-0.96431E+00,-0.96553E+00, + &-0.96675E+00,-0.96796E+00,-0.96917E+00,-0.97037E+00,-0.97157E+00/ + + DATA (BNC02M (I),I=201,300)/ + &-0.97277E+00,-0.97396E+00,-0.97514E+00,-0.97633E+00,-0.97751E+00, + &-0.97868E+00,-0.97985E+00,-0.98102E+00,-0.98218E+00,-0.98334E+00, + &-0.98450E+00,-0.98565E+00,-0.98680E+00,-0.98795E+00,-0.98909E+00, + &-0.99023E+00,-0.99136E+00,-0.99249E+00,-0.99362E+00,-0.99474E+00, + &-0.99586E+00,-0.99698E+00,-0.99809E+00,-0.99920E+00,-0.10003E+01, + &-0.10014E+01,-0.10025E+01,-0.10036E+01,-0.10047E+01,-0.10058E+01, + &-0.10069E+01,-0.10080E+01,-0.10091E+01,-0.10101E+01,-0.10112E+01, + &-0.10123E+01,-0.10133E+01,-0.10144E+01,-0.10155E+01,-0.10165E+01, + &-0.10176E+01,-0.10187E+01,-0.10197E+01,-0.10208E+01,-0.10218E+01, + &-0.10228E+01,-0.10239E+01,-0.10249E+01,-0.10260E+01,-0.10270E+01, + &-0.10280E+01,-0.10291E+01,-0.10301E+01,-0.10311E+01,-0.10321E+01, + &-0.10331E+01,-0.10341E+01,-0.10352E+01,-0.10362E+01,-0.10372E+01, + &-0.10382E+01,-0.10392E+01,-0.10402E+01,-0.10412E+01,-0.10422E+01, + &-0.10432E+01,-0.10442E+01,-0.10451E+01,-0.10461E+01,-0.10471E+01, + &-0.10481E+01,-0.10491E+01,-0.10500E+01,-0.10510E+01,-0.10520E+01, + &-0.10530E+01,-0.10539E+01,-0.10549E+01,-0.10559E+01,-0.10568E+01, + &-0.10578E+01,-0.10587E+01,-0.10597E+01,-0.10606E+01,-0.10616E+01, + &-0.10625E+01,-0.10635E+01,-0.10644E+01,-0.10654E+01,-0.10663E+01, + &-0.10672E+01,-0.10682E+01,-0.10691E+01,-0.10700E+01,-0.10710E+01, + &-0.10719E+01,-0.10728E+01,-0.10737E+01,-0.10747E+01,-0.10756E+01/ + + DATA (BNC02M (I),I=301,400)/ + &-0.10765E+01,-0.10774E+01,-0.10783E+01,-0.10792E+01,-0.10801E+01, + &-0.10811E+01,-0.10820E+01,-0.10829E+01,-0.10838E+01,-0.10847E+01, + &-0.10856E+01,-0.10865E+01,-0.10874E+01,-0.10883E+01,-0.10891E+01, + &-0.10900E+01,-0.10909E+01,-0.10918E+01,-0.10927E+01,-0.10936E+01, + &-0.10945E+01,-0.10953E+01,-0.10962E+01,-0.10971E+01,-0.10980E+01, + &-0.10988E+01,-0.10997E+01,-0.11006E+01,-0.11015E+01,-0.11023E+01, + &-0.11032E+01,-0.11040E+01,-0.11049E+01,-0.11058E+01,-0.11066E+01, + &-0.11075E+01,-0.11083E+01,-0.11092E+01,-0.11101E+01,-0.11109E+01, + &-0.11118E+01,-0.11126E+01,-0.11134E+01,-0.11143E+01,-0.11151E+01, + &-0.11160E+01,-0.11168E+01,-0.11177E+01,-0.11185E+01,-0.11193E+01, + &-0.11202E+01,-0.11210E+01,-0.11218E+01,-0.11227E+01,-0.11235E+01, + &-0.11243E+01,-0.11252E+01,-0.11260E+01,-0.11268E+01,-0.11276E+01, + &-0.11284E+01,-0.11293E+01,-0.11301E+01,-0.11309E+01,-0.11317E+01, + &-0.11325E+01,-0.11333E+01,-0.11342E+01,-0.11350E+01,-0.11358E+01, + &-0.11366E+01,-0.11374E+01,-0.11382E+01,-0.11390E+01,-0.11398E+01, + &-0.11406E+01,-0.11414E+01,-0.11422E+01,-0.11430E+01,-0.11438E+01, + &-0.11446E+01,-0.11454E+01,-0.11462E+01,-0.11470E+01,-0.11478E+01, + &-0.11486E+01,-0.11493E+01,-0.11501E+01,-0.11509E+01,-0.11517E+01, + &-0.11525E+01,-0.11533E+01,-0.11541E+01,-0.11548E+01,-0.11556E+01, + &-0.11564E+01,-0.11572E+01,-0.11579E+01,-0.11587E+01,-0.11595E+01/ + + DATA (BNC02M (I),I=401,500)/ + &-0.11603E+01,-0.11610E+01,-0.11618E+01,-0.11626E+01,-0.11633E+01, + &-0.11641E+01,-0.11649E+01,-0.11656E+01,-0.11664E+01,-0.11672E+01, + &-0.11679E+01,-0.11687E+01,-0.11694E+01,-0.11702E+01,-0.11710E+01, + &-0.11717E+01,-0.11725E+01,-0.11732E+01,-0.11740E+01,-0.11747E+01, + &-0.11755E+01,-0.11762E+01,-0.11770E+01,-0.11777E+01,-0.11785E+01, + &-0.11792E+01,-0.11800E+01,-0.11807E+01,-0.11815E+01,-0.11822E+01, + &-0.11829E+01,-0.11837E+01,-0.11844E+01,-0.11852E+01,-0.11859E+01, + &-0.11866E+01,-0.11874E+01,-0.11881E+01,-0.11888E+01,-0.11896E+01, + &-0.11903E+01,-0.11910E+01,-0.11918E+01,-0.11925E+01,-0.11932E+01, + &-0.11940E+01,-0.11947E+01,-0.11954E+01,-0.11961E+01,-0.11969E+01, + &-0.11976E+01,-0.11983E+01,-0.11990E+01,-0.11997E+01,-0.12005E+01, + &-0.12012E+01,-0.12019E+01,-0.12026E+01,-0.12033E+01,-0.12040E+01, + &-0.12048E+01,-0.12055E+01,-0.12062E+01,-0.12069E+01,-0.12076E+01, + &-0.12083E+01,-0.12090E+01,-0.12097E+01,-0.12104E+01,-0.12111E+01, + &-0.12118E+01,-0.12126E+01,-0.12133E+01,-0.12140E+01,-0.12147E+01, + &-0.12154E+01,-0.12161E+01,-0.12168E+01,-0.12175E+01,-0.12182E+01, + &-0.12189E+01,-0.12196E+01,-0.12203E+01,-0.12209E+01,-0.12216E+01, + &-0.12223E+01,-0.12230E+01,-0.12237E+01,-0.12244E+01,-0.12251E+01, + &-0.12258E+01,-0.12265E+01,-0.12272E+01,-0.12279E+01,-0.12285E+01, + &-0.12292E+01,-0.12299E+01,-0.12306E+01,-0.12313E+01,-0.12320E+01/ + + DATA (BNC02M (I),I=501,600)/ + &-0.12327E+01,-0.12333E+01,-0.12340E+01,-0.12347E+01,-0.12354E+01, + &-0.12361E+01,-0.12367E+01,-0.12374E+01,-0.12381E+01,-0.12388E+01, + &-0.12394E+01,-0.12401E+01,-0.12408E+01,-0.12415E+01,-0.12421E+01, + &-0.12428E+01,-0.12435E+01,-0.12441E+01,-0.12448E+01,-0.12455E+01, + &-0.12462E+01,-0.12468E+01,-0.12475E+01,-0.12482E+01,-0.12488E+01, + &-0.12495E+01,-0.12501E+01,-0.12508E+01,-0.12515E+01,-0.12521E+01, + &-0.12528E+01,-0.12535E+01,-0.12541E+01,-0.12548E+01,-0.12554E+01, + &-0.12561E+01,-0.12568E+01,-0.12574E+01,-0.12581E+01,-0.12587E+01, + &-0.12594E+01,-0.12600E+01,-0.12607E+01,-0.12613E+01,-0.12620E+01, + &-0.12626E+01,-0.12633E+01,-0.12639E+01,-0.12646E+01,-0.12652E+01, + &-0.12659E+01,-0.12665E+01,-0.12672E+01,-0.12678E+01,-0.12685E+01, + &-0.12691E+01,-0.12698E+01,-0.12704E+01,-0.12711E+01,-0.12717E+01, + &-0.12724E+01,-0.12730E+01,-0.12736E+01,-0.12743E+01,-0.12749E+01, + &-0.12756E+01,-0.12762E+01,-0.12768E+01,-0.12775E+01,-0.12781E+01, + &-0.12788E+01,-0.12794E+01,-0.12800E+01,-0.12807E+01,-0.12813E+01, + &-0.12819E+01,-0.12826E+01,-0.12832E+01,-0.12838E+01,-0.12845E+01, + &-0.12851E+01,-0.12857E+01,-0.12864E+01,-0.12870E+01,-0.12876E+01, + &-0.12882E+01,-0.12889E+01,-0.12895E+01,-0.12901E+01,-0.12908E+01, + &-0.12914E+01,-0.12920E+01,-0.12926E+01,-0.12933E+01,-0.12939E+01, + &-0.12945E+01,-0.12951E+01,-0.12957E+01,-0.12964E+01,-0.12987E+01/ + + DATA (BNC02M (I),I=601,700)/ + &-0.13038E+01,-0.13099E+01,-0.13160E+01,-0.13220E+01,-0.13280E+01, + &-0.13340E+01,-0.13399E+01,-0.13457E+01,-0.13515E+01,-0.13573E+01, + &-0.13631E+01,-0.13688E+01,-0.13744E+01,-0.13801E+01,-0.13856E+01, + &-0.13912E+01,-0.13967E+01,-0.14022E+01,-0.14077E+01,-0.14131E+01, + &-0.14185E+01,-0.14239E+01,-0.14292E+01,-0.14345E+01,-0.14398E+01, + &-0.14451E+01,-0.14503E+01,-0.14555E+01,-0.14607E+01,-0.14659E+01, + &-0.14710E+01,-0.14761E+01,-0.14812E+01,-0.14862E+01,-0.14913E+01, + &-0.14963E+01,-0.15013E+01,-0.15063E+01,-0.15112E+01,-0.15161E+01, + &-0.15211E+01,-0.15260E+01,-0.15308E+01,-0.15357E+01,-0.15405E+01, + &-0.15453E+01,-0.15501E+01,-0.15549E+01,-0.15597E+01,-0.15644E+01, + &-0.15692E+01,-0.15739E+01,-0.15786E+01,-0.15833E+01,-0.15880E+01, + &-0.15926E+01,-0.15972E+01,-0.16019E+01,-0.16065E+01,-0.16111E+01, + &-0.16157E+01,-0.16202E+01,-0.16248E+01,-0.16293E+01,-0.16338E+01, + &-0.16384E+01,-0.16429E+01,-0.16473E+01,-0.16518E+01,-0.16563E+01, + &-0.16607E+01,-0.16652E+01,-0.16696E+01,-0.16740E+01,-0.16784E+01, + &-0.16828E+01,-0.16872E+01,-0.16915E+01,-0.16959E+01,-0.17003E+01, + &-0.17046E+01,-0.17089E+01,-0.17132E+01,-0.17175E+01,-0.17218E+01, + &-0.17261E+01,-0.17304E+01,-0.17347E+01,-0.17389E+01,-0.17432E+01, + &-0.17474E+01,-0.17516E+01,-0.17559E+01,-0.17601E+01,-0.17643E+01, + &-0.17685E+01,-0.17726E+01,-0.17768E+01,-0.17810E+01,-0.17851E+01/ + + DATA (BNC02M(I),I=701,741)/ + &-0.17893E+01,-0.17934E+01,-0.17976E+01,-0.18017E+01,-0.18058E+01, + &-0.18099E+01,-0.18140E+01,-0.18181E+01,-0.18222E+01,-0.18263E+01, + &-0.18304E+01,-0.18344E+01,-0.18385E+01,-0.18425E+01,-0.18466E+01, + &-0.18506E+01,-0.18547E+01,-0.18587E+01,-0.18627E+01,-0.18667E+01, + &-0.18707E+01,-0.18747E+01,-0.18787E+01,-0.18827E+01,-0.18866E+01, + &-0.18906E+01,-0.18946E+01,-0.18985E+01,-0.19025E+01,-0.19064E+01, + &-0.19104E+01,-0.19143E+01,-0.19182E+01,-0.19222E+01,-0.19261E+01, + &-0.19300E+01,-0.19339E+01,-0.19378E+01,-0.19417E+01,-0.19456E+01, + &-0.19495E+01 + & / +C +C *** NaNO3 +C + DATA (BNC03M (I),I= 1,100)/ + &-0.53018E-01,-0.97087E-01,-0.12849E+00,-0.15010E+00,-0.16692E+00, + &-0.18081E+00,-0.19271E+00,-0.20315E+00,-0.21248E+00,-0.22092E+00, + &-0.22865E+00,-0.23578E+00,-0.24240E+00,-0.24860E+00,-0.25441E+00, + &-0.25991E+00,-0.26511E+00,-0.27005E+00,-0.27476E+00,-0.27927E+00, + &-0.28358E+00,-0.28773E+00,-0.29171E+00,-0.29555E+00,-0.29926E+00, + &-0.30284E+00,-0.30631E+00,-0.30967E+00,-0.31293E+00,-0.31609E+00, + &-0.31917E+00,-0.32216E+00,-0.32508E+00,-0.32792E+00,-0.33069E+00, + &-0.33340E+00,-0.33604E+00,-0.33862E+00,-0.34115E+00,-0.34361E+00, + &-0.34603E+00,-0.34840E+00,-0.35072E+00,-0.35299E+00,-0.35522E+00, + &-0.35741E+00,-0.35956E+00,-0.36167E+00,-0.36374E+00,-0.36578E+00, + &-0.36778E+00,-0.36974E+00,-0.37168E+00,-0.37358E+00,-0.37546E+00, + &-0.37730E+00,-0.37912E+00,-0.38091E+00,-0.38268E+00,-0.38442E+00, + &-0.38613E+00,-0.38783E+00,-0.38950E+00,-0.39115E+00,-0.39278E+00, + &-0.39439E+00,-0.39597E+00,-0.39754E+00,-0.39910E+00,-0.40063E+00, + &-0.40215E+00,-0.40365E+00,-0.40514E+00,-0.40661E+00,-0.40807E+00, + &-0.40951E+00,-0.41094E+00,-0.41236E+00,-0.41376E+00,-0.41515E+00, + &-0.41653E+00,-0.41790E+00,-0.41926E+00,-0.42061E+00,-0.42194E+00, + &-0.42327E+00,-0.42459E+00,-0.42590E+00,-0.42720E+00,-0.42849E+00, + &-0.42977E+00,-0.43104E+00,-0.43231E+00,-0.43356E+00,-0.43481E+00, + &-0.43605E+00,-0.43729E+00,-0.43852E+00,-0.43974E+00,-0.44095E+00/ + + DATA (BNC03M (I),I=101,200)/ + &-0.44215E+00,-0.44335E+00,-0.44455E+00,-0.44573E+00,-0.44691E+00, + &-0.44808E+00,-0.44925E+00,-0.45041E+00,-0.45156E+00,-0.45271E+00, + &-0.45385E+00,-0.45499E+00,-0.45611E+00,-0.45724E+00,-0.45836E+00, + &-0.45947E+00,-0.46057E+00,-0.46167E+00,-0.46277E+00,-0.46385E+00, + &-0.46489E+00,-0.46597E+00,-0.46705E+00,-0.46812E+00,-0.46918E+00, + &-0.47024E+00,-0.47129E+00,-0.47234E+00,-0.47338E+00,-0.47442E+00, + &-0.47545E+00,-0.47647E+00,-0.47749E+00,-0.47850E+00,-0.47951E+00, + &-0.48052E+00,-0.48152E+00,-0.48251E+00,-0.48350E+00,-0.48448E+00, + &-0.48546E+00,-0.48644E+00,-0.48741E+00,-0.48837E+00,-0.48934E+00, + &-0.49029E+00,-0.49124E+00,-0.49219E+00,-0.49313E+00,-0.49407E+00, + &-0.49501E+00,-0.49594E+00,-0.49687E+00,-0.49779E+00,-0.49871E+00, + &-0.49962E+00,-0.50053E+00,-0.50144E+00,-0.50234E+00,-0.50324E+00, + &-0.50414E+00,-0.50503E+00,-0.50592E+00,-0.50680E+00,-0.50768E+00, + &-0.50856E+00,-0.50943E+00,-0.51030E+00,-0.51117E+00,-0.51203E+00, + &-0.51289E+00,-0.51375E+00,-0.51460E+00,-0.51545E+00,-0.51630E+00, + &-0.51714E+00,-0.51798E+00,-0.51882E+00,-0.51965E+00,-0.52048E+00, + &-0.52131E+00,-0.52213E+00,-0.52295E+00,-0.52377E+00,-0.52459E+00, + &-0.52540E+00,-0.52621E+00,-0.52702E+00,-0.52782E+00,-0.52862E+00, + &-0.52942E+00,-0.53022E+00,-0.53101E+00,-0.53180E+00,-0.53259E+00, + &-0.53337E+00,-0.53416E+00,-0.53493E+00,-0.53571E+00,-0.53649E+00/ + + DATA (BNC03M (I),I=201,300)/ + &-0.53726E+00,-0.53803E+00,-0.53879E+00,-0.53956E+00,-0.54032E+00, + &-0.54108E+00,-0.54184E+00,-0.54259E+00,-0.54334E+00,-0.54409E+00, + &-0.54484E+00,-0.54559E+00,-0.54633E+00,-0.54707E+00,-0.54781E+00, + &-0.54854E+00,-0.54928E+00,-0.55001E+00,-0.55074E+00,-0.55147E+00, + &-0.55219E+00,-0.55291E+00,-0.55363E+00,-0.55435E+00,-0.55507E+00, + &-0.55578E+00,-0.55650E+00,-0.55721E+00,-0.55791E+00,-0.55862E+00, + &-0.55932E+00,-0.56003E+00,-0.56073E+00,-0.56142E+00,-0.56212E+00, + &-0.56282E+00,-0.56351E+00,-0.56420E+00,-0.56489E+00,-0.56557E+00, + &-0.56626E+00,-0.56694E+00,-0.56762E+00,-0.56830E+00,-0.56898E+00, + &-0.56966E+00,-0.57033E+00,-0.57100E+00,-0.57167E+00,-0.57234E+00, + &-0.57301E+00,-0.57367E+00,-0.57434E+00,-0.57500E+00,-0.57566E+00, + &-0.57632E+00,-0.57697E+00,-0.57763E+00,-0.57828E+00,-0.57893E+00, + &-0.57958E+00,-0.58023E+00,-0.58088E+00,-0.58153E+00,-0.58217E+00, + &-0.58281E+00,-0.58345E+00,-0.58409E+00,-0.58473E+00,-0.58537E+00, + &-0.58600E+00,-0.58663E+00,-0.58726E+00,-0.58789E+00,-0.58852E+00, + &-0.58915E+00,-0.58978E+00,-0.59040E+00,-0.59102E+00,-0.59164E+00, + &-0.59226E+00,-0.59288E+00,-0.59350E+00,-0.59411E+00,-0.59473E+00, + &-0.59534E+00,-0.59595E+00,-0.59656E+00,-0.59717E+00,-0.59778E+00, + &-0.59838E+00,-0.59899E+00,-0.59959E+00,-0.60019E+00,-0.60079E+00, + &-0.60139E+00,-0.60199E+00,-0.60259E+00,-0.60318E+00,-0.60378E+00/ + + DATA (BNC03M (I),I=301,400)/ + &-0.60437E+00,-0.60496E+00,-0.60555E+00,-0.60614E+00,-0.60673E+00, + &-0.60732E+00,-0.60790E+00,-0.60849E+00,-0.60907E+00,-0.60965E+00, + &-0.61023E+00,-0.61081E+00,-0.61139E+00,-0.61197E+00,-0.61254E+00, + &-0.61312E+00,-0.61369E+00,-0.61426E+00,-0.61484E+00,-0.61541E+00, + &-0.61597E+00,-0.61654E+00,-0.61711E+00,-0.61767E+00,-0.61824E+00, + &-0.61880E+00,-0.61936E+00,-0.61993E+00,-0.62049E+00,-0.62104E+00, + &-0.62160E+00,-0.62216E+00,-0.62272E+00,-0.62327E+00,-0.62382E+00, + &-0.62438E+00,-0.62493E+00,-0.62548E+00,-0.62603E+00,-0.62658E+00, + &-0.62712E+00,-0.62767E+00,-0.62822E+00,-0.62876E+00,-0.62930E+00, + &-0.62985E+00,-0.63039E+00,-0.63093E+00,-0.63147E+00,-0.63201E+00, + &-0.63254E+00,-0.63308E+00,-0.63362E+00,-0.63415E+00,-0.63468E+00, + &-0.63522E+00,-0.63575E+00,-0.63628E+00,-0.63681E+00,-0.63734E+00, + &-0.63787E+00,-0.63839E+00,-0.63892E+00,-0.63945E+00,-0.63997E+00, + &-0.64049E+00,-0.64102E+00,-0.64154E+00,-0.64206E+00,-0.64258E+00, + &-0.64310E+00,-0.64362E+00,-0.64413E+00,-0.64465E+00,-0.64516E+00, + &-0.64568E+00,-0.64619E+00,-0.64671E+00,-0.64722E+00,-0.64773E+00, + &-0.64824E+00,-0.64875E+00,-0.64926E+00,-0.64977E+00,-0.65027E+00, + &-0.65078E+00,-0.65129E+00,-0.65179E+00,-0.65229E+00,-0.65280E+00, + &-0.65330E+00,-0.65380E+00,-0.65430E+00,-0.65480E+00,-0.65530E+00, + &-0.65580E+00,-0.65630E+00,-0.65679E+00,-0.65729E+00,-0.65778E+00/ + + DATA (BNC03M (I),I=401,500)/ + &-0.65828E+00,-0.65877E+00,-0.65926E+00,-0.65976E+00,-0.66025E+00, + &-0.66074E+00,-0.66123E+00,-0.66172E+00,-0.66221E+00,-0.66269E+00, + &-0.66318E+00,-0.66367E+00,-0.66415E+00,-0.66464E+00,-0.66512E+00, + &-0.66560E+00,-0.66609E+00,-0.66657E+00,-0.66705E+00,-0.66753E+00, + &-0.66801E+00,-0.66849E+00,-0.66897E+00,-0.66944E+00,-0.66992E+00, + &-0.67040E+00,-0.67087E+00,-0.67135E+00,-0.67182E+00,-0.67229E+00, + &-0.67277E+00,-0.67324E+00,-0.67371E+00,-0.67418E+00,-0.67465E+00, + &-0.67512E+00,-0.67559E+00,-0.67606E+00,-0.67652E+00,-0.67699E+00, + &-0.67746E+00,-0.67792E+00,-0.67839E+00,-0.67885E+00,-0.67931E+00, + &-0.67978E+00,-0.68024E+00,-0.68070E+00,-0.68116E+00,-0.68162E+00, + &-0.68208E+00,-0.68254E+00,-0.68300E+00,-0.68346E+00,-0.68391E+00, + &-0.68437E+00,-0.68483E+00,-0.68528E+00,-0.68574E+00,-0.68619E+00, + &-0.68664E+00,-0.68710E+00,-0.68755E+00,-0.68800E+00,-0.68845E+00, + &-0.68890E+00,-0.68935E+00,-0.68980E+00,-0.69025E+00,-0.69070E+00, + &-0.69115E+00,-0.69159E+00,-0.69204E+00,-0.69249E+00,-0.69293E+00, + &-0.69338E+00,-0.69382E+00,-0.69426E+00,-0.69471E+00,-0.69515E+00, + &-0.69559E+00,-0.69603E+00,-0.69647E+00,-0.69691E+00,-0.69735E+00, + &-0.69779E+00,-0.69823E+00,-0.69867E+00,-0.69911E+00,-0.69954E+00, + &-0.69998E+00,-0.70042E+00,-0.70085E+00,-0.70129E+00,-0.70172E+00, + &-0.70216E+00,-0.70259E+00,-0.70302E+00,-0.70345E+00,-0.70389E+00/ + + DATA (BNC03M (I),I=501,600)/ + &-0.70432E+00,-0.70475E+00,-0.70518E+00,-0.70561E+00,-0.70604E+00, + &-0.70646E+00,-0.70689E+00,-0.70732E+00,-0.70775E+00,-0.70817E+00, + &-0.70860E+00,-0.70903E+00,-0.70945E+00,-0.70987E+00,-0.71030E+00, + &-0.71072E+00,-0.71115E+00,-0.71157E+00,-0.71199E+00,-0.71241E+00, + &-0.71283E+00,-0.71325E+00,-0.71367E+00,-0.71409E+00,-0.71451E+00, + &-0.71493E+00,-0.71535E+00,-0.71577E+00,-0.71618E+00,-0.71660E+00, + &-0.71702E+00,-0.71743E+00,-0.71785E+00,-0.71826E+00,-0.71868E+00, + &-0.71909E+00,-0.71951E+00,-0.71992E+00,-0.72033E+00,-0.72074E+00, + &-0.72116E+00,-0.72157E+00,-0.72198E+00,-0.72239E+00,-0.72280E+00, + &-0.72321E+00,-0.72362E+00,-0.72403E+00,-0.72443E+00,-0.72484E+00, + &-0.72525E+00,-0.72566E+00,-0.72606E+00,-0.72647E+00,-0.72687E+00, + &-0.72728E+00,-0.72768E+00,-0.72809E+00,-0.72849E+00,-0.72890E+00, + &-0.72930E+00,-0.72970E+00,-0.73010E+00,-0.73050E+00,-0.73091E+00, + &-0.73131E+00,-0.73171E+00,-0.73211E+00,-0.73251E+00,-0.73291E+00, + &-0.73330E+00,-0.73370E+00,-0.73410E+00,-0.73450E+00,-0.73490E+00, + &-0.73529E+00,-0.73569E+00,-0.73609E+00,-0.73648E+00,-0.73688E+00, + &-0.73727E+00,-0.73766E+00,-0.73806E+00,-0.73845E+00,-0.73885E+00, + &-0.73924E+00,-0.73963E+00,-0.74002E+00,-0.74041E+00,-0.74081E+00, + &-0.74120E+00,-0.74159E+00,-0.74198E+00,-0.74237E+00,-0.74276E+00, + &-0.74314E+00,-0.74353E+00,-0.74392E+00,-0.74431E+00,-0.74576E+00/ + + DATA (BNC03M (I),I=601,700)/ + &-0.74893E+00,-0.75275E+00,-0.75652E+00,-0.76027E+00,-0.76398E+00, + &-0.76765E+00,-0.77130E+00,-0.77492E+00,-0.77850E+00,-0.78206E+00, + &-0.78558E+00,-0.78908E+00,-0.79256E+00,-0.79600E+00,-0.79942E+00, + &-0.80282E+00,-0.80619E+00,-0.80954E+00,-0.81286E+00,-0.81616E+00, + &-0.81944E+00,-0.82270E+00,-0.82594E+00,-0.82915E+00,-0.83235E+00, + &-0.83552E+00,-0.83868E+00,-0.84181E+00,-0.84493E+00,-0.84803E+00, + &-0.85111E+00,-0.85417E+00,-0.85722E+00,-0.86025E+00,-0.86326E+00, + &-0.86626E+00,-0.86924E+00,-0.87221E+00,-0.87515E+00,-0.87809E+00, + &-0.88101E+00,-0.88391E+00,-0.88681E+00,-0.88968E+00,-0.89255E+00, + &-0.89540E+00,-0.89823E+00,-0.90106E+00,-0.90387E+00,-0.90666E+00, + &-0.90945E+00,-0.91222E+00,-0.91499E+00,-0.91773E+00,-0.92047E+00, + &-0.92320E+00,-0.92592E+00,-0.92862E+00,-0.93131E+00,-0.93400E+00, + &-0.93667E+00,-0.93933E+00,-0.94198E+00,-0.94462E+00,-0.94726E+00, + &-0.94988E+00,-0.95249E+00,-0.95509E+00,-0.95769E+00,-0.96027E+00, + &-0.96285E+00,-0.96541E+00,-0.96797E+00,-0.97052E+00,-0.97306E+00, + &-0.97559E+00,-0.97812E+00,-0.98063E+00,-0.98314E+00,-0.98564E+00, + &-0.98813E+00,-0.99062E+00,-0.99309E+00,-0.99556E+00,-0.99802E+00, + &-0.10005E+01,-0.10029E+01,-0.10054E+01,-0.10078E+01,-0.10102E+01, + &-0.10126E+01,-0.10150E+01,-0.10175E+01,-0.10198E+01,-0.10222E+01, + &-0.10246E+01,-0.10270E+01,-0.10294E+01,-0.10317E+01,-0.10341E+01/ + + DATA (BNC03M(I),I=701,741)/ + &-0.10365E+01,-0.10388E+01,-0.10411E+01,-0.10435E+01,-0.10458E+01, + &-0.10481E+01,-0.10505E+01,-0.10528E+01,-0.10551E+01,-0.10574E+01, + &-0.10597E+01,-0.10620E+01,-0.10642E+01,-0.10665E+01,-0.10688E+01, + &-0.10711E+01,-0.10733E+01,-0.10756E+01,-0.10778E+01,-0.10801E+01, + &-0.10823E+01,-0.10846E+01,-0.10868E+01,-0.10890E+01,-0.10913E+01, + &-0.10935E+01,-0.10957E+01,-0.10979E+01,-0.11001E+01,-0.11023E+01, + &-0.11045E+01,-0.11067E+01,-0.11089E+01,-0.11111E+01,-0.11133E+01, + &-0.11154E+01,-0.11176E+01,-0.11198E+01,-0.11219E+01,-0.11241E+01, + &-0.11263E+01 + & / +C +C *** (NH4)2SO4 +C + DATA (BNC04M (I),I= 1,100)/ + &-0.10581E+00,-0.19334E+00,-0.25539E+00,-0.29790E+00,-0.33085E+00, + &-0.35796E+00,-0.38111E+00,-0.40135E+00,-0.41938E+00,-0.43565E+00, + &-0.45050E+00,-0.46416E+00,-0.47682E+00,-0.48862E+00,-0.49969E+00, + &-0.51010E+00,-0.51994E+00,-0.52928E+00,-0.53815E+00,-0.54662E+00, + &-0.55471E+00,-0.56247E+00,-0.56992E+00,-0.57708E+00,-0.58397E+00, + &-0.59063E+00,-0.59706E+00,-0.60328E+00,-0.60931E+00,-0.61515E+00, + &-0.62082E+00,-0.62634E+00,-0.63169E+00,-0.63691E+00,-0.64199E+00, + &-0.64694E+00,-0.65178E+00,-0.65649E+00,-0.66110E+00,-0.66560E+00, + &-0.67000E+00,-0.67431E+00,-0.67853E+00,-0.68266E+00,-0.68670E+00, + &-0.69067E+00,-0.69456E+00,-0.69838E+00,-0.70212E+00,-0.70580E+00, + &-0.70942E+00,-0.71297E+00,-0.71646E+00,-0.71989E+00,-0.72326E+00, + &-0.72659E+00,-0.72986E+00,-0.73308E+00,-0.73625E+00,-0.73937E+00, + &-0.74245E+00,-0.74549E+00,-0.74848E+00,-0.75143E+00,-0.75435E+00, + &-0.75722E+00,-0.76006E+00,-0.76287E+00,-0.76564E+00,-0.76837E+00, + &-0.77108E+00,-0.77375E+00,-0.77640E+00,-0.77901E+00,-0.78160E+00, + &-0.78416E+00,-0.78670E+00,-0.78921E+00,-0.79169E+00,-0.79415E+00, + &-0.79659E+00,-0.79901E+00,-0.80140E+00,-0.80378E+00,-0.80613E+00, + &-0.80847E+00,-0.81078E+00,-0.81308E+00,-0.81536E+00,-0.81762E+00, + &-0.81986E+00,-0.82209E+00,-0.82430E+00,-0.82649E+00,-0.82867E+00, + &-0.83083E+00,-0.83298E+00,-0.83512E+00,-0.83724E+00,-0.83934E+00/ + + DATA (BNC04M (I),I=101,200)/ + &-0.84143E+00,-0.84351E+00,-0.84558E+00,-0.84763E+00,-0.84967E+00, + &-0.85169E+00,-0.85371E+00,-0.85571E+00,-0.85770E+00,-0.85967E+00, + &-0.86164E+00,-0.86359E+00,-0.86553E+00,-0.86746E+00,-0.86938E+00, + &-0.87129E+00,-0.87319E+00,-0.87507E+00,-0.87695E+00,-0.87881E+00, + &-0.88061E+00,-0.88246E+00,-0.88430E+00,-0.88612E+00,-0.88794E+00, + &-0.88975E+00,-0.89154E+00,-0.89333E+00,-0.89510E+00,-0.89687E+00, + &-0.89862E+00,-0.90037E+00,-0.90211E+00,-0.90383E+00,-0.90555E+00, + &-0.90726E+00,-0.90896E+00,-0.91065E+00,-0.91233E+00,-0.91401E+00, + &-0.91567E+00,-0.91733E+00,-0.91897E+00,-0.92061E+00,-0.92225E+00, + &-0.92387E+00,-0.92549E+00,-0.92710E+00,-0.92870E+00,-0.93029E+00, + &-0.93188E+00,-0.93345E+00,-0.93502E+00,-0.93659E+00,-0.93814E+00, + &-0.93969E+00,-0.94124E+00,-0.94277E+00,-0.94430E+00,-0.94582E+00, + &-0.94734E+00,-0.94885E+00,-0.95035E+00,-0.95185E+00,-0.95334E+00, + &-0.95482E+00,-0.95630E+00,-0.95777E+00,-0.95923E+00,-0.96069E+00, + &-0.96215E+00,-0.96359E+00,-0.96504E+00,-0.96647E+00,-0.96790E+00, + &-0.96933E+00,-0.97075E+00,-0.97216E+00,-0.97357E+00,-0.97497E+00, + &-0.97637E+00,-0.97776E+00,-0.97915E+00,-0.98053E+00,-0.98190E+00, + &-0.98327E+00,-0.98464E+00,-0.98600E+00,-0.98736E+00,-0.98871E+00, + &-0.99006E+00,-0.99140E+00,-0.99274E+00,-0.99407E+00,-0.99540E+00, + &-0.99672E+00,-0.99804E+00,-0.99935E+00,-0.10007E+01,-0.10020E+01/ + + DATA (BNC04M (I),I=201,300)/ + &-0.10033E+01,-0.10046E+01,-0.10059E+01,-0.10071E+01,-0.10084E+01, + &-0.10097E+01,-0.10110E+01,-0.10123E+01,-0.10135E+01,-0.10148E+01, + &-0.10160E+01,-0.10173E+01,-0.10186E+01,-0.10198E+01,-0.10210E+01, + &-0.10223E+01,-0.10235E+01,-0.10248E+01,-0.10260E+01,-0.10272E+01, + &-0.10284E+01,-0.10296E+01,-0.10309E+01,-0.10321E+01,-0.10333E+01, + &-0.10345E+01,-0.10357E+01,-0.10369E+01,-0.10381E+01,-0.10393E+01, + &-0.10404E+01,-0.10416E+01,-0.10428E+01,-0.10440E+01,-0.10451E+01, + &-0.10463E+01,-0.10475E+01,-0.10486E+01,-0.10498E+01,-0.10510E+01, + &-0.10521E+01,-0.10533E+01,-0.10544E+01,-0.10556E+01,-0.10567E+01, + &-0.10578E+01,-0.10590E+01,-0.10601E+01,-0.10612E+01,-0.10624E+01, + &-0.10635E+01,-0.10646E+01,-0.10657E+01,-0.10668E+01,-0.10679E+01, + &-0.10690E+01,-0.10702E+01,-0.10713E+01,-0.10724E+01,-0.10735E+01, + &-0.10745E+01,-0.10756E+01,-0.10767E+01,-0.10778E+01,-0.10789E+01, + &-0.10800E+01,-0.10811E+01,-0.10821E+01,-0.10832E+01,-0.10843E+01, + &-0.10853E+01,-0.10864E+01,-0.10875E+01,-0.10885E+01,-0.10896E+01, + &-0.10907E+01,-0.10917E+01,-0.10928E+01,-0.10938E+01,-0.10949E+01, + &-0.10959E+01,-0.10969E+01,-0.10980E+01,-0.10990E+01,-0.11001E+01, + &-0.11011E+01,-0.11021E+01,-0.11031E+01,-0.11042E+01,-0.11052E+01, + &-0.11062E+01,-0.11072E+01,-0.11083E+01,-0.11093E+01,-0.11103E+01, + &-0.11113E+01,-0.11123E+01,-0.11133E+01,-0.11143E+01,-0.11153E+01/ + + DATA (BNC04M (I),I=301,400)/ + &-0.11163E+01,-0.11173E+01,-0.11183E+01,-0.11193E+01,-0.11203E+01, + &-0.11213E+01,-0.11223E+01,-0.11232E+01,-0.11242E+01,-0.11252E+01, + &-0.11262E+01,-0.11272E+01,-0.11281E+01,-0.11291E+01,-0.11301E+01, + &-0.11311E+01,-0.11320E+01,-0.11330E+01,-0.11340E+01,-0.11349E+01, + &-0.11359E+01,-0.11368E+01,-0.11378E+01,-0.11388E+01,-0.11397E+01, + &-0.11407E+01,-0.11416E+01,-0.11426E+01,-0.11435E+01,-0.11444E+01, + &-0.11454E+01,-0.11463E+01,-0.11473E+01,-0.11482E+01,-0.11491E+01, + &-0.11501E+01,-0.11510E+01,-0.11519E+01,-0.11529E+01,-0.11538E+01, + &-0.11547E+01,-0.11556E+01,-0.11566E+01,-0.11575E+01,-0.11584E+01, + &-0.11593E+01,-0.11602E+01,-0.11612E+01,-0.11621E+01,-0.11630E+01, + &-0.11639E+01,-0.11648E+01,-0.11657E+01,-0.11666E+01,-0.11675E+01, + &-0.11684E+01,-0.11693E+01,-0.11702E+01,-0.11711E+01,-0.11720E+01, + &-0.11729E+01,-0.11738E+01,-0.11747E+01,-0.11756E+01,-0.11764E+01, + &-0.11773E+01,-0.11782E+01,-0.11791E+01,-0.11800E+01,-0.11809E+01, + &-0.11817E+01,-0.11826E+01,-0.11835E+01,-0.11844E+01,-0.11852E+01, + &-0.11861E+01,-0.11870E+01,-0.11879E+01,-0.11887E+01,-0.11896E+01, + &-0.11905E+01,-0.11913E+01,-0.11922E+01,-0.11930E+01,-0.11939E+01, + &-0.11948E+01,-0.11956E+01,-0.11965E+01,-0.11973E+01,-0.11982E+01, + &-0.11990E+01,-0.11999E+01,-0.12007E+01,-0.12016E+01,-0.12024E+01, + &-0.12033E+01,-0.12041E+01,-0.12050E+01,-0.12058E+01,-0.12067E+01/ + + DATA (BNC04M (I),I=401,500)/ + &-0.12075E+01,-0.12083E+01,-0.12092E+01,-0.12100E+01,-0.12108E+01, + &-0.12117E+01,-0.12125E+01,-0.12133E+01,-0.12142E+01,-0.12150E+01, + &-0.12158E+01,-0.12166E+01,-0.12175E+01,-0.12183E+01,-0.12191E+01, + &-0.12199E+01,-0.12208E+01,-0.12216E+01,-0.12224E+01,-0.12232E+01, + &-0.12240E+01,-0.12248E+01,-0.12257E+01,-0.12265E+01,-0.12273E+01, + &-0.12281E+01,-0.12289E+01,-0.12297E+01,-0.12305E+01,-0.12313E+01, + &-0.12321E+01,-0.12329E+01,-0.12337E+01,-0.12345E+01,-0.12353E+01, + &-0.12361E+01,-0.12369E+01,-0.12377E+01,-0.12385E+01,-0.12393E+01, + &-0.12401E+01,-0.12409E+01,-0.12417E+01,-0.12425E+01,-0.12433E+01, + &-0.12441E+01,-0.12449E+01,-0.12456E+01,-0.12464E+01,-0.12472E+01, + &-0.12480E+01,-0.12488E+01,-0.12496E+01,-0.12503E+01,-0.12511E+01, + &-0.12519E+01,-0.12527E+01,-0.12535E+01,-0.12542E+01,-0.12550E+01, + &-0.12558E+01,-0.12566E+01,-0.12573E+01,-0.12581E+01,-0.12589E+01, + &-0.12596E+01,-0.12604E+01,-0.12612E+01,-0.12619E+01,-0.12627E+01, + &-0.12635E+01,-0.12642E+01,-0.12650E+01,-0.12658E+01,-0.12665E+01, + &-0.12673E+01,-0.12680E+01,-0.12688E+01,-0.12696E+01,-0.12703E+01, + &-0.12711E+01,-0.12718E+01,-0.12726E+01,-0.12733E+01,-0.12741E+01, + &-0.12748E+01,-0.12756E+01,-0.12763E+01,-0.12771E+01,-0.12778E+01, + &-0.12786E+01,-0.12793E+01,-0.12801E+01,-0.12808E+01,-0.12816E+01, + &-0.12823E+01,-0.12830E+01,-0.12838E+01,-0.12845E+01,-0.12853E+01/ + + DATA (BNC04M (I),I=501,600)/ + &-0.12860E+01,-0.12867E+01,-0.12875E+01,-0.12882E+01,-0.12890E+01, + &-0.12897E+01,-0.12904E+01,-0.12912E+01,-0.12919E+01,-0.12926E+01, + &-0.12933E+01,-0.12941E+01,-0.12948E+01,-0.12955E+01,-0.12963E+01, + &-0.12970E+01,-0.12977E+01,-0.12984E+01,-0.12992E+01,-0.12999E+01, + &-0.13006E+01,-0.13013E+01,-0.13021E+01,-0.13028E+01,-0.13035E+01, + &-0.13042E+01,-0.13049E+01,-0.13057E+01,-0.13064E+01,-0.13071E+01, + &-0.13078E+01,-0.13085E+01,-0.13092E+01,-0.13099E+01,-0.13107E+01, + &-0.13114E+01,-0.13121E+01,-0.13128E+01,-0.13135E+01,-0.13142E+01, + &-0.13149E+01,-0.13156E+01,-0.13163E+01,-0.13170E+01,-0.13177E+01, + &-0.13184E+01,-0.13191E+01,-0.13198E+01,-0.13206E+01,-0.13213E+01, + &-0.13220E+01,-0.13227E+01,-0.13234E+01,-0.13241E+01,-0.13248E+01, + &-0.13254E+01,-0.13261E+01,-0.13268E+01,-0.13275E+01,-0.13282E+01, + &-0.13289E+01,-0.13296E+01,-0.13303E+01,-0.13310E+01,-0.13317E+01, + &-0.13324E+01,-0.13331E+01,-0.13338E+01,-0.13345E+01,-0.13351E+01, + &-0.13358E+01,-0.13365E+01,-0.13372E+01,-0.13379E+01,-0.13386E+01, + &-0.13393E+01,-0.13399E+01,-0.13406E+01,-0.13413E+01,-0.13420E+01, + &-0.13427E+01,-0.13434E+01,-0.13440E+01,-0.13447E+01,-0.13454E+01, + &-0.13461E+01,-0.13467E+01,-0.13474E+01,-0.13481E+01,-0.13488E+01, + &-0.13495E+01,-0.13501E+01,-0.13508E+01,-0.13515E+01,-0.13521E+01, + &-0.13528E+01,-0.13535E+01,-0.13542E+01,-0.13548E+01,-0.13573E+01/ + + DATA (BNC04M (I),I=601,700)/ + &-0.13628E+01,-0.13694E+01,-0.13760E+01,-0.13825E+01,-0.13889E+01, + &-0.13953E+01,-0.14016E+01,-0.14079E+01,-0.14142E+01,-0.14204E+01, + &-0.14265E+01,-0.14327E+01,-0.14387E+01,-0.14448E+01,-0.14507E+01, + &-0.14567E+01,-0.14626E+01,-0.14685E+01,-0.14743E+01,-0.14801E+01, + &-0.14859E+01,-0.14916E+01,-0.14973E+01,-0.15030E+01,-0.15087E+01, + &-0.15143E+01,-0.15198E+01,-0.15254E+01,-0.15309E+01,-0.15364E+01, + &-0.15419E+01,-0.15473E+01,-0.15527E+01,-0.15581E+01,-0.15635E+01, + &-0.15688E+01,-0.15741E+01,-0.15794E+01,-0.15846E+01,-0.15899E+01, + &-0.15951E+01,-0.16003E+01,-0.16055E+01,-0.16106E+01,-0.16157E+01, + &-0.16208E+01,-0.16259E+01,-0.16310E+01,-0.16360E+01,-0.16411E+01, + &-0.16461E+01,-0.16511E+01,-0.16560E+01,-0.16610E+01,-0.16659E+01, + &-0.16708E+01,-0.16757E+01,-0.16806E+01,-0.16855E+01,-0.16903E+01, + &-0.16952E+01,-0.17000E+01,-0.17048E+01,-0.17096E+01,-0.17143E+01, + &-0.17191E+01,-0.17238E+01,-0.17285E+01,-0.17333E+01,-0.17379E+01, + &-0.17426E+01,-0.17473E+01,-0.17520E+01,-0.17566E+01,-0.17612E+01, + &-0.17658E+01,-0.17704E+01,-0.17750E+01,-0.17796E+01,-0.17842E+01, + &-0.17887E+01,-0.17933E+01,-0.17978E+01,-0.18023E+01,-0.18068E+01, + &-0.18113E+01,-0.18158E+01,-0.18203E+01,-0.18247E+01,-0.18292E+01, + &-0.18336E+01,-0.18380E+01,-0.18425E+01,-0.18469E+01,-0.18513E+01, + &-0.18556E+01,-0.18600E+01,-0.18644E+01,-0.18687E+01,-0.18731E+01/ + + DATA (BNC04M(I),I=701,741)/ + &-0.18774E+01,-0.18818E+01,-0.18861E+01,-0.18904E+01,-0.18947E+01, + &-0.18990E+01,-0.19033E+01,-0.19075E+01,-0.19118E+01,-0.19161E+01, + &-0.19203E+01,-0.19245E+01,-0.19288E+01,-0.19330E+01,-0.19372E+01, + &-0.19414E+01,-0.19456E+01,-0.19498E+01,-0.19540E+01,-0.19582E+01, + &-0.19623E+01,-0.19665E+01,-0.19707E+01,-0.19748E+01,-0.19789E+01, + &-0.19831E+01,-0.19872E+01,-0.19913E+01,-0.19954E+01,-0.19995E+01, + &-0.20036E+01,-0.20077E+01,-0.20118E+01,-0.20159E+01,-0.20199E+01, + &-0.20240E+01,-0.20280E+01,-0.20321E+01,-0.20361E+01,-0.20402E+01, + &-0.20442E+01 + & / +C +C *** NH4NO3 +C + DATA (BNC05M (I),I= 1,100)/ + &-0.53657E-01,-0.99475E-01,-0.13304E+00,-0.15671E+00,-0.17551E+00, + &-0.19133E+00,-0.20511E+00,-0.21739E+00,-0.22852E+00,-0.23874E+00, + &-0.24821E+00,-0.25706E+00,-0.26538E+00,-0.27325E+00,-0.28072E+00, + &-0.28785E+00,-0.29466E+00,-0.30120E+00,-0.30749E+00,-0.31356E+00, + &-0.31941E+00,-0.32508E+00,-0.33057E+00,-0.33590E+00,-0.34108E+00, + &-0.34612E+00,-0.35103E+00,-0.35582E+00,-0.36049E+00,-0.36505E+00, + &-0.36951E+00,-0.37386E+00,-0.37813E+00,-0.38230E+00,-0.38639E+00, + &-0.39040E+00,-0.39433E+00,-0.39818E+00,-0.40197E+00,-0.40568E+00, + &-0.40933E+00,-0.41291E+00,-0.41643E+00,-0.41989E+00,-0.42330E+00, + &-0.42664E+00,-0.42994E+00,-0.43318E+00,-0.43637E+00,-0.43952E+00, + &-0.44261E+00,-0.44566E+00,-0.44867E+00,-0.45164E+00,-0.45456E+00, + &-0.45744E+00,-0.46029E+00,-0.46310E+00,-0.46587E+00,-0.46861E+00, + &-0.47132E+00,-0.47400E+00,-0.47664E+00,-0.47926E+00,-0.48184E+00, + &-0.48440E+00,-0.48694E+00,-0.48945E+00,-0.49193E+00,-0.49440E+00, + &-0.49684E+00,-0.49926E+00,-0.50166E+00,-0.50404E+00,-0.50640E+00, + &-0.50875E+00,-0.51108E+00,-0.51339E+00,-0.51569E+00,-0.51797E+00, + &-0.52024E+00,-0.52250E+00,-0.52474E+00,-0.52697E+00,-0.52919E+00, + &-0.53140E+00,-0.53360E+00,-0.53579E+00,-0.53797E+00,-0.54014E+00, + &-0.54229E+00,-0.54444E+00,-0.54659E+00,-0.54872E+00,-0.55084E+00, + &-0.55296E+00,-0.55507E+00,-0.55717E+00,-0.55926E+00,-0.56135E+00/ + + DATA (BNC05M (I),I=101,200)/ + &-0.56342E+00,-0.56549E+00,-0.56755E+00,-0.56961E+00,-0.57165E+00, + &-0.57369E+00,-0.57572E+00,-0.57775E+00,-0.57976E+00,-0.58177E+00, + &-0.58377E+00,-0.58576E+00,-0.58774E+00,-0.58972E+00,-0.59169E+00, + &-0.59364E+00,-0.59560E+00,-0.59754E+00,-0.59947E+00,-0.60140E+00, + &-0.60319E+00,-0.60512E+00,-0.60703E+00,-0.60894E+00,-0.61083E+00, + &-0.61272E+00,-0.61459E+00,-0.61646E+00,-0.61832E+00,-0.62017E+00, + &-0.62201E+00,-0.62384E+00,-0.62566E+00,-0.62748E+00,-0.62928E+00, + &-0.63108E+00,-0.63287E+00,-0.63465E+00,-0.63642E+00,-0.63819E+00, + &-0.63994E+00,-0.64169E+00,-0.64343E+00,-0.64516E+00,-0.64689E+00, + &-0.64860E+00,-0.65031E+00,-0.65201E+00,-0.65371E+00,-0.65539E+00, + &-0.65707E+00,-0.65875E+00,-0.66041E+00,-0.66207E+00,-0.66372E+00, + &-0.66536E+00,-0.66700E+00,-0.66863E+00,-0.67025E+00,-0.67187E+00, + &-0.67348E+00,-0.67508E+00,-0.67668E+00,-0.67827E+00,-0.67985E+00, + &-0.68143E+00,-0.68300E+00,-0.68456E+00,-0.68612E+00,-0.68767E+00, + &-0.68922E+00,-0.69076E+00,-0.69229E+00,-0.69382E+00,-0.69534E+00, + &-0.69686E+00,-0.69837E+00,-0.69987E+00,-0.70137E+00,-0.70286E+00, + &-0.70435E+00,-0.70583E+00,-0.70731E+00,-0.70878E+00,-0.71024E+00, + &-0.71170E+00,-0.71316E+00,-0.71460E+00,-0.71605E+00,-0.71749E+00, + &-0.71892E+00,-0.72035E+00,-0.72177E+00,-0.72319E+00,-0.72460E+00, + &-0.72600E+00,-0.72741E+00,-0.72880E+00,-0.73020E+00,-0.73158E+00/ + + DATA (BNC05M (I),I=201,300)/ + &-0.73297E+00,-0.73434E+00,-0.73572E+00,-0.73708E+00,-0.73845E+00, + &-0.73980E+00,-0.74116E+00,-0.74251E+00,-0.74385E+00,-0.74519E+00, + &-0.74653E+00,-0.74786E+00,-0.74918E+00,-0.75051E+00,-0.75182E+00, + &-0.75314E+00,-0.75445E+00,-0.75575E+00,-0.75705E+00,-0.75835E+00, + &-0.75964E+00,-0.76092E+00,-0.76221E+00,-0.76349E+00,-0.76476E+00, + &-0.76603E+00,-0.76730E+00,-0.76856E+00,-0.76982E+00,-0.77107E+00, + &-0.77232E+00,-0.77357E+00,-0.77481E+00,-0.77605E+00,-0.77729E+00, + &-0.77852E+00,-0.77974E+00,-0.78097E+00,-0.78219E+00,-0.78340E+00, + &-0.78461E+00,-0.78582E+00,-0.78703E+00,-0.78823E+00,-0.78943E+00, + &-0.79062E+00,-0.79181E+00,-0.79300E+00,-0.79418E+00,-0.79536E+00, + &-0.79653E+00,-0.79771E+00,-0.79887E+00,-0.80004E+00,-0.80120E+00, + &-0.80236E+00,-0.80351E+00,-0.80467E+00,-0.80581E+00,-0.80696E+00, + &-0.80810E+00,-0.80924E+00,-0.81037E+00,-0.81150E+00,-0.81263E+00, + &-0.81376E+00,-0.81488E+00,-0.81600E+00,-0.81711E+00,-0.81823E+00, + &-0.81934E+00,-0.82044E+00,-0.82155E+00,-0.82264E+00,-0.82374E+00, + &-0.82484E+00,-0.82593E+00,-0.82701E+00,-0.82810E+00,-0.82918E+00, + &-0.83026E+00,-0.83133E+00,-0.83241E+00,-0.83348E+00,-0.83454E+00, + &-0.83561E+00,-0.83667E+00,-0.83773E+00,-0.83878E+00,-0.83984E+00, + &-0.84089E+00,-0.84193E+00,-0.84298E+00,-0.84402E+00,-0.84506E+00, + &-0.84609E+00,-0.84713E+00,-0.84816E+00,-0.84918E+00,-0.85021E+00/ + + DATA (BNC05M (I),I=301,400)/ + &-0.85123E+00,-0.85225E+00,-0.85327E+00,-0.85428E+00,-0.85529E+00, + &-0.85630E+00,-0.85731E+00,-0.85831E+00,-0.85932E+00,-0.86031E+00, + &-0.86131E+00,-0.86230E+00,-0.86330E+00,-0.86428E+00,-0.86527E+00, + &-0.86625E+00,-0.86724E+00,-0.86821E+00,-0.86919E+00,-0.87016E+00, + &-0.87114E+00,-0.87210E+00,-0.87307E+00,-0.87404E+00,-0.87500E+00, + &-0.87596E+00,-0.87691E+00,-0.87787E+00,-0.87882E+00,-0.87977E+00, + &-0.88072E+00,-0.88167E+00,-0.88261E+00,-0.88355E+00,-0.88449E+00, + &-0.88542E+00,-0.88636E+00,-0.88729E+00,-0.88822E+00,-0.88915E+00, + &-0.89007E+00,-0.89100E+00,-0.89192E+00,-0.89284E+00,-0.89375E+00, + &-0.89467E+00,-0.89558E+00,-0.89649E+00,-0.89740E+00,-0.89830E+00, + &-0.89921E+00,-0.90011E+00,-0.90101E+00,-0.90191E+00,-0.90280E+00, + &-0.90370E+00,-0.90459E+00,-0.90548E+00,-0.90636E+00,-0.90725E+00, + &-0.90813E+00,-0.90901E+00,-0.90989E+00,-0.91077E+00,-0.91165E+00, + &-0.91252E+00,-0.91339E+00,-0.91426E+00,-0.91513E+00,-0.91599E+00, + &-0.91686E+00,-0.91772E+00,-0.91858E+00,-0.91944E+00,-0.92029E+00, + &-0.92115E+00,-0.92200E+00,-0.92285E+00,-0.92370E+00,-0.92455E+00, + &-0.92539E+00,-0.92623E+00,-0.92707E+00,-0.92791E+00,-0.92875E+00, + &-0.92959E+00,-0.93042E+00,-0.93125E+00,-0.93208E+00,-0.93291E+00, + &-0.93374E+00,-0.93456E+00,-0.93539E+00,-0.93621E+00,-0.93703E+00, + &-0.93785E+00,-0.93866E+00,-0.93948E+00,-0.94029E+00,-0.94110E+00/ + + DATA (BNC05M (I),I=401,500)/ + &-0.94191E+00,-0.94272E+00,-0.94353E+00,-0.94433E+00,-0.94513E+00, + &-0.94594E+00,-0.94673E+00,-0.94753E+00,-0.94833E+00,-0.94912E+00, + &-0.94992E+00,-0.95071E+00,-0.95150E+00,-0.95229E+00,-0.95307E+00, + &-0.95386E+00,-0.95464E+00,-0.95542E+00,-0.95620E+00,-0.95698E+00, + &-0.95776E+00,-0.95853E+00,-0.95931E+00,-0.96008E+00,-0.96085E+00, + &-0.96162E+00,-0.96239E+00,-0.96316E+00,-0.96392E+00,-0.96468E+00, + &-0.96545E+00,-0.96621E+00,-0.96696E+00,-0.96772E+00,-0.96848E+00, + &-0.96923E+00,-0.96999E+00,-0.97074E+00,-0.97149E+00,-0.97224E+00, + &-0.97298E+00,-0.97373E+00,-0.97447E+00,-0.97522E+00,-0.97596E+00, + &-0.97670E+00,-0.97744E+00,-0.97817E+00,-0.97891E+00,-0.97964E+00, + &-0.98038E+00,-0.98111E+00,-0.98184E+00,-0.98257E+00,-0.98329E+00, + &-0.98402E+00,-0.98474E+00,-0.98547E+00,-0.98619E+00,-0.98691E+00, + &-0.98763E+00,-0.98835E+00,-0.98906E+00,-0.98978E+00,-0.99049E+00, + &-0.99121E+00,-0.99192E+00,-0.99263E+00,-0.99334E+00,-0.99404E+00, + &-0.99475E+00,-0.99546E+00,-0.99616E+00,-0.99686E+00,-0.99756E+00, + &-0.99826E+00,-0.99896E+00,-0.99966E+00,-0.10004E+01,-0.10011E+01, + &-0.10017E+01,-0.10024E+01,-0.10031E+01,-0.10038E+01,-0.10045E+01, + &-0.10052E+01,-0.10059E+01,-0.10066E+01,-0.10072E+01,-0.10079E+01, + &-0.10086E+01,-0.10093E+01,-0.10100E+01,-0.10106E+01,-0.10113E+01, + &-0.10120E+01,-0.10127E+01,-0.10133E+01,-0.10140E+01,-0.10147E+01/ + + DATA (BNC05M (I),I=501,600)/ + &-0.10154E+01,-0.10160E+01,-0.10167E+01,-0.10174E+01,-0.10180E+01, + &-0.10187E+01,-0.10194E+01,-0.10200E+01,-0.10207E+01,-0.10213E+01, + &-0.10220E+01,-0.10227E+01,-0.10233E+01,-0.10240E+01,-0.10246E+01, + &-0.10253E+01,-0.10259E+01,-0.10266E+01,-0.10272E+01,-0.10279E+01, + &-0.10285E+01,-0.10292E+01,-0.10298E+01,-0.10305E+01,-0.10311E+01, + &-0.10317E+01,-0.10324E+01,-0.10330E+01,-0.10337E+01,-0.10343E+01, + &-0.10349E+01,-0.10356E+01,-0.10362E+01,-0.10368E+01,-0.10375E+01, + &-0.10381E+01,-0.10387E+01,-0.10394E+01,-0.10400E+01,-0.10406E+01, + &-0.10412E+01,-0.10419E+01,-0.10425E+01,-0.10431E+01,-0.10437E+01, + &-0.10444E+01,-0.10450E+01,-0.10456E+01,-0.10462E+01,-0.10468E+01, + &-0.10474E+01,-0.10481E+01,-0.10487E+01,-0.10493E+01,-0.10499E+01, + &-0.10505E+01,-0.10511E+01,-0.10517E+01,-0.10523E+01,-0.10530E+01, + &-0.10536E+01,-0.10542E+01,-0.10548E+01,-0.10554E+01,-0.10560E+01, + &-0.10566E+01,-0.10572E+01,-0.10578E+01,-0.10584E+01,-0.10590E+01, + &-0.10596E+01,-0.10602E+01,-0.10608E+01,-0.10614E+01,-0.10620E+01, + &-0.10626E+01,-0.10631E+01,-0.10637E+01,-0.10643E+01,-0.10649E+01, + &-0.10655E+01,-0.10661E+01,-0.10667E+01,-0.10673E+01,-0.10678E+01, + &-0.10684E+01,-0.10690E+01,-0.10696E+01,-0.10702E+01,-0.10708E+01, + &-0.10713E+01,-0.10719E+01,-0.10725E+01,-0.10731E+01,-0.10737E+01, + &-0.10742E+01,-0.10748E+01,-0.10754E+01,-0.10759E+01,-0.10781E+01/ + + DATA (BNC05M (I),I=601,700)/ + &-0.10828E+01,-0.10883E+01,-0.10939E+01,-0.10993E+01,-0.11047E+01, + &-0.11099E+01,-0.11152E+01,-0.11203E+01,-0.11254E+01,-0.11304E+01, + &-0.11354E+01,-0.11403E+01,-0.11451E+01,-0.11499E+01,-0.11546E+01, + &-0.11593E+01,-0.11639E+01,-0.11685E+01,-0.11730E+01,-0.11775E+01, + &-0.11819E+01,-0.11863E+01,-0.11906E+01,-0.11949E+01,-0.11991E+01, + &-0.12033E+01,-0.12075E+01,-0.12116E+01,-0.12156E+01,-0.12197E+01, + &-0.12237E+01,-0.12276E+01,-0.12316E+01,-0.12355E+01,-0.12393E+01, + &-0.12431E+01,-0.12469E+01,-0.12507E+01,-0.12544E+01,-0.12581E+01, + &-0.12618E+01,-0.12654E+01,-0.12690E+01,-0.12726E+01,-0.12761E+01, + &-0.12797E+01,-0.12831E+01,-0.12866E+01,-0.12901E+01,-0.12935E+01, + &-0.12969E+01,-0.13002E+01,-0.13036E+01,-0.13069E+01,-0.13102E+01, + &-0.13135E+01,-0.13167E+01,-0.13200E+01,-0.13232E+01,-0.13264E+01, + &-0.13295E+01,-0.13327E+01,-0.13358E+01,-0.13389E+01,-0.13420E+01, + &-0.13451E+01,-0.13481E+01,-0.13512E+01,-0.13542E+01,-0.13572E+01, + &-0.13601E+01,-0.13631E+01,-0.13661E+01,-0.13690E+01,-0.13719E+01, + &-0.13748E+01,-0.13777E+01,-0.13806E+01,-0.13834E+01,-0.13863E+01, + &-0.13891E+01,-0.13919E+01,-0.13947E+01,-0.13975E+01,-0.14002E+01, + &-0.14030E+01,-0.14057E+01,-0.14085E+01,-0.14112E+01,-0.14139E+01, + &-0.14166E+01,-0.14192E+01,-0.14219E+01,-0.14246E+01,-0.14272E+01, + &-0.14298E+01,-0.14325E+01,-0.14351E+01,-0.14377E+01,-0.14402E+01/ + + DATA (BNC05M(I),I=701,741)/ + &-0.14428E+01,-0.14454E+01,-0.14479E+01,-0.14505E+01,-0.14530E+01, + &-0.14555E+01,-0.14581E+01,-0.14606E+01,-0.14631E+01,-0.14655E+01, + &-0.14680E+01,-0.14705E+01,-0.14729E+01,-0.14754E+01,-0.14778E+01, + &-0.14803E+01,-0.14827E+01,-0.14851E+01,-0.14875E+01,-0.14899E+01, + &-0.14923E+01,-0.14947E+01,-0.14970E+01,-0.14994E+01,-0.15017E+01, + &-0.15041E+01,-0.15064E+01,-0.15088E+01,-0.15111E+01,-0.15134E+01, + &-0.15157E+01,-0.15180E+01,-0.15203E+01,-0.15226E+01,-0.15249E+01, + &-0.15272E+01,-0.15294E+01,-0.15317E+01,-0.15340E+01,-0.15362E+01, + &-0.15385E+01 + & / +C +C *** NH4Cl +C + DATA (BNC06M (I),I= 1,100)/ + &-0.52099E-01,-0.93686E-01,-0.12205E+00,-0.14078E+00,-0.15483E+00, + &-0.16604E+00,-0.17532E+00,-0.18320E+00,-0.19002E+00,-0.19599E+00, + &-0.20128E+00,-0.20600E+00,-0.21026E+00,-0.21411E+00,-0.21762E+00, + &-0.22082E+00,-0.22376E+00,-0.22646E+00,-0.22896E+00,-0.23127E+00, + &-0.23341E+00,-0.23540E+00,-0.23725E+00,-0.23898E+00,-0.24060E+00, + &-0.24211E+00,-0.24353E+00,-0.24485E+00,-0.24610E+00,-0.24727E+00, + &-0.24837E+00,-0.24941E+00,-0.25039E+00,-0.25131E+00,-0.25218E+00, + &-0.25300E+00,-0.25378E+00,-0.25452E+00,-0.25521E+00,-0.25587E+00, + &-0.25650E+00,-0.25709E+00,-0.25766E+00,-0.25819E+00,-0.25870E+00, + &-0.25918E+00,-0.25963E+00,-0.26007E+00,-0.26048E+00,-0.26088E+00, + &-0.26125E+00,-0.26160E+00,-0.26194E+00,-0.26226E+00,-0.26257E+00, + &-0.26285E+00,-0.26313E+00,-0.26339E+00,-0.26363E+00,-0.26386E+00, + &-0.26408E+00,-0.26429E+00,-0.26448E+00,-0.26466E+00,-0.26483E+00, + &-0.26499E+00,-0.26513E+00,-0.26527E+00,-0.26539E+00,-0.26550E+00, + &-0.26560E+00,-0.26569E+00,-0.26576E+00,-0.26583E+00,-0.26588E+00, + &-0.26593E+00,-0.26596E+00,-0.26598E+00,-0.26600E+00,-0.26600E+00, + &-0.26599E+00,-0.26597E+00,-0.26594E+00,-0.26590E+00,-0.26584E+00, + &-0.26578E+00,-0.26571E+00,-0.26563E+00,-0.26553E+00,-0.26543E+00, + &-0.26532E+00,-0.26520E+00,-0.26507E+00,-0.26492E+00,-0.26477E+00, + &-0.26462E+00,-0.26445E+00,-0.26427E+00,-0.26409E+00,-0.26390E+00/ + + DATA (BNC06M (I),I=101,200)/ + &-0.26370E+00,-0.26349E+00,-0.26327E+00,-0.26305E+00,-0.26282E+00, + &-0.26258E+00,-0.26234E+00,-0.26209E+00,-0.26184E+00,-0.26158E+00, + &-0.26131E+00,-0.26104E+00,-0.26076E+00,-0.26048E+00,-0.26020E+00, + &-0.25991E+00,-0.25961E+00,-0.25931E+00,-0.25901E+00,-0.25870E+00, + &-0.25848E+00,-0.25816E+00,-0.25783E+00,-0.25751E+00,-0.25718E+00, + &-0.25684E+00,-0.25651E+00,-0.25617E+00,-0.25584E+00,-0.25550E+00, + &-0.25516E+00,-0.25481E+00,-0.25447E+00,-0.25412E+00,-0.25378E+00, + &-0.25343E+00,-0.25308E+00,-0.25273E+00,-0.25237E+00,-0.25202E+00, + &-0.25167E+00,-0.25131E+00,-0.25095E+00,-0.25060E+00,-0.25024E+00, + &-0.24988E+00,-0.24951E+00,-0.24915E+00,-0.24879E+00,-0.24843E+00, + &-0.24806E+00,-0.24770E+00,-0.24733E+00,-0.24696E+00,-0.24659E+00, + &-0.24623E+00,-0.24586E+00,-0.24549E+00,-0.24512E+00,-0.24475E+00, + &-0.24438E+00,-0.24400E+00,-0.24363E+00,-0.24326E+00,-0.24289E+00, + &-0.24251E+00,-0.24214E+00,-0.24176E+00,-0.24139E+00,-0.24101E+00, + &-0.24064E+00,-0.24026E+00,-0.23988E+00,-0.23951E+00,-0.23913E+00, + &-0.23875E+00,-0.23838E+00,-0.23800E+00,-0.23762E+00,-0.23724E+00, + &-0.23687E+00,-0.23649E+00,-0.23611E+00,-0.23573E+00,-0.23535E+00, + &-0.23498E+00,-0.23460E+00,-0.23422E+00,-0.23384E+00,-0.23346E+00, + &-0.23308E+00,-0.23270E+00,-0.23232E+00,-0.23195E+00,-0.23157E+00, + &-0.23119E+00,-0.23081E+00,-0.23043E+00,-0.23005E+00,-0.22968E+00/ + + DATA (BNC06M (I),I=201,300)/ + &-0.22930E+00,-0.22892E+00,-0.22854E+00,-0.22816E+00,-0.22779E+00, + &-0.22741E+00,-0.22703E+00,-0.22665E+00,-0.22628E+00,-0.22590E+00, + &-0.22552E+00,-0.22515E+00,-0.22477E+00,-0.22439E+00,-0.22402E+00, + &-0.22364E+00,-0.22327E+00,-0.22289E+00,-0.22252E+00,-0.22214E+00, + &-0.22177E+00,-0.22139E+00,-0.22102E+00,-0.22064E+00,-0.22027E+00, + &-0.21990E+00,-0.21953E+00,-0.21915E+00,-0.21878E+00,-0.21841E+00, + &-0.21804E+00,-0.21767E+00,-0.21729E+00,-0.21692E+00,-0.21655E+00, + &-0.21618E+00,-0.21581E+00,-0.21544E+00,-0.21508E+00,-0.21471E+00, + &-0.21434E+00,-0.21397E+00,-0.21360E+00,-0.21324E+00,-0.21287E+00, + &-0.21250E+00,-0.21214E+00,-0.21177E+00,-0.21141E+00,-0.21104E+00, + &-0.21068E+00,-0.21031E+00,-0.20995E+00,-0.20958E+00,-0.20922E+00, + &-0.20886E+00,-0.20850E+00,-0.20814E+00,-0.20777E+00,-0.20741E+00, + &-0.20705E+00,-0.20669E+00,-0.20633E+00,-0.20597E+00,-0.20561E+00, + &-0.20526E+00,-0.20490E+00,-0.20454E+00,-0.20418E+00,-0.20383E+00, + &-0.20347E+00,-0.20312E+00,-0.20276E+00,-0.20241E+00,-0.20205E+00, + &-0.20170E+00,-0.20134E+00,-0.20099E+00,-0.20064E+00,-0.20029E+00, + &-0.19993E+00,-0.19958E+00,-0.19923E+00,-0.19888E+00,-0.19853E+00, + &-0.19818E+00,-0.19783E+00,-0.19749E+00,-0.19714E+00,-0.19679E+00, + &-0.19644E+00,-0.19610E+00,-0.19575E+00,-0.19541E+00,-0.19506E+00, + &-0.19472E+00,-0.19437E+00,-0.19403E+00,-0.19369E+00,-0.19334E+00/ + + DATA (BNC06M (I),I=301,400)/ + &-0.19300E+00,-0.19266E+00,-0.19232E+00,-0.19198E+00,-0.19164E+00, + &-0.19130E+00,-0.19096E+00,-0.19062E+00,-0.19028E+00,-0.18994E+00, + &-0.18961E+00,-0.18927E+00,-0.18893E+00,-0.18860E+00,-0.18826E+00, + &-0.18793E+00,-0.18759E+00,-0.18726E+00,-0.18692E+00,-0.18659E+00, + &-0.18626E+00,-0.18593E+00,-0.18560E+00,-0.18526E+00,-0.18493E+00, + &-0.18460E+00,-0.18427E+00,-0.18395E+00,-0.18362E+00,-0.18329E+00, + &-0.18296E+00,-0.18263E+00,-0.18231E+00,-0.18198E+00,-0.18166E+00, + &-0.18133E+00,-0.18101E+00,-0.18068E+00,-0.18036E+00,-0.18004E+00, + &-0.17971E+00,-0.17939E+00,-0.17907E+00,-0.17875E+00,-0.17843E+00, + &-0.17811E+00,-0.17779E+00,-0.17747E+00,-0.17715E+00,-0.17683E+00, + &-0.17652E+00,-0.17620E+00,-0.17588E+00,-0.17557E+00,-0.17525E+00, + &-0.17493E+00,-0.17462E+00,-0.17431E+00,-0.17399E+00,-0.17368E+00, + &-0.17337E+00,-0.17305E+00,-0.17274E+00,-0.17243E+00,-0.17212E+00, + &-0.17181E+00,-0.17150E+00,-0.17119E+00,-0.17088E+00,-0.17057E+00, + &-0.17027E+00,-0.16996E+00,-0.16965E+00,-0.16934E+00,-0.16904E+00, + &-0.16873E+00,-0.16843E+00,-0.16812E+00,-0.16782E+00,-0.16752E+00, + &-0.16721E+00,-0.16691E+00,-0.16661E+00,-0.16631E+00,-0.16601E+00, + &-0.16571E+00,-0.16540E+00,-0.16511E+00,-0.16481E+00,-0.16451E+00, + &-0.16421E+00,-0.16391E+00,-0.16361E+00,-0.16332E+00,-0.16302E+00, + &-0.16273E+00,-0.16243E+00,-0.16213E+00,-0.16184E+00,-0.16155E+00/ + + DATA (BNC06M (I),I=401,500)/ + &-0.16125E+00,-0.16096E+00,-0.16067E+00,-0.16038E+00,-0.16008E+00, + &-0.15979E+00,-0.15950E+00,-0.15921E+00,-0.15892E+00,-0.15863E+00, + &-0.15834E+00,-0.15806E+00,-0.15777E+00,-0.15748E+00,-0.15719E+00, + &-0.15691E+00,-0.15662E+00,-0.15634E+00,-0.15605E+00,-0.15577E+00, + &-0.15548E+00,-0.15520E+00,-0.15492E+00,-0.15463E+00,-0.15435E+00, + &-0.15407E+00,-0.15379E+00,-0.15351E+00,-0.15323E+00,-0.15295E+00, + &-0.15267E+00,-0.15239E+00,-0.15211E+00,-0.15183E+00,-0.15155E+00, + &-0.15127E+00,-0.15100E+00,-0.15072E+00,-0.15045E+00,-0.15017E+00, + &-0.14990E+00,-0.14962E+00,-0.14935E+00,-0.14907E+00,-0.14880E+00, + &-0.14853E+00,-0.14825E+00,-0.14798E+00,-0.14771E+00,-0.14744E+00, + &-0.14717E+00,-0.14690E+00,-0.14663E+00,-0.14636E+00,-0.14609E+00, + &-0.14582E+00,-0.14555E+00,-0.14529E+00,-0.14502E+00,-0.14475E+00, + &-0.14449E+00,-0.14422E+00,-0.14396E+00,-0.14369E+00,-0.14343E+00, + &-0.14316E+00,-0.14290E+00,-0.14264E+00,-0.14237E+00,-0.14211E+00, + &-0.14185E+00,-0.14159E+00,-0.14133E+00,-0.14107E+00,-0.14081E+00, + &-0.14055E+00,-0.14029E+00,-0.14003E+00,-0.13977E+00,-0.13951E+00, + &-0.13925E+00,-0.13900E+00,-0.13874E+00,-0.13848E+00,-0.13823E+00, + &-0.13797E+00,-0.13772E+00,-0.13746E+00,-0.13721E+00,-0.13695E+00, + &-0.13670E+00,-0.13645E+00,-0.13619E+00,-0.13594E+00,-0.13569E+00, + &-0.13544E+00,-0.13519E+00,-0.13494E+00,-0.13469E+00,-0.13444E+00/ + + DATA (BNC06M (I),I=501,600)/ + &-0.13419E+00,-0.13394E+00,-0.13369E+00,-0.13344E+00,-0.13319E+00, + &-0.13295E+00,-0.13270E+00,-0.13245E+00,-0.13221E+00,-0.13196E+00, + &-0.13172E+00,-0.13147E+00,-0.13123E+00,-0.13098E+00,-0.13074E+00, + &-0.13050E+00,-0.13025E+00,-0.13001E+00,-0.12977E+00,-0.12953E+00, + &-0.12929E+00,-0.12904E+00,-0.12880E+00,-0.12856E+00,-0.12832E+00, + &-0.12808E+00,-0.12785E+00,-0.12761E+00,-0.12737E+00,-0.12713E+00, + &-0.12689E+00,-0.12666E+00,-0.12642E+00,-0.12618E+00,-0.12595E+00, + &-0.12571E+00,-0.12548E+00,-0.12524E+00,-0.12501E+00,-0.12477E+00, + &-0.12454E+00,-0.12431E+00,-0.12407E+00,-0.12384E+00,-0.12361E+00, + &-0.12338E+00,-0.12315E+00,-0.12292E+00,-0.12269E+00,-0.12246E+00, + &-0.12223E+00,-0.12200E+00,-0.12177E+00,-0.12154E+00,-0.12131E+00, + &-0.12108E+00,-0.12086E+00,-0.12063E+00,-0.12040E+00,-0.12017E+00, + &-0.11995E+00,-0.11972E+00,-0.11950E+00,-0.11927E+00,-0.11905E+00, + &-0.11882E+00,-0.11860E+00,-0.11838E+00,-0.11815E+00,-0.11793E+00, + &-0.11771E+00,-0.11749E+00,-0.11726E+00,-0.11704E+00,-0.11682E+00, + &-0.11660E+00,-0.11638E+00,-0.11616E+00,-0.11594E+00,-0.11572E+00, + &-0.11550E+00,-0.11529E+00,-0.11507E+00,-0.11485E+00,-0.11463E+00, + &-0.11441E+00,-0.11420E+00,-0.11398E+00,-0.11377E+00,-0.11355E+00, + &-0.11333E+00,-0.11312E+00,-0.11291E+00,-0.11269E+00,-0.11248E+00, + &-0.11226E+00,-0.11205E+00,-0.11184E+00,-0.11163E+00,-0.11083E+00/ + + DATA (BNC06M (I),I=601,700)/ + &-0.10910E+00,-0.10704E+00,-0.10500E+00,-0.10300E+00,-0.10104E+00, + &-0.99099E-01,-0.97194E-01,-0.95319E-01,-0.93474E-01,-0.91659E-01, + &-0.89872E-01,-0.88115E-01,-0.86385E-01,-0.84682E-01,-0.83007E-01, + &-0.81358E-01,-0.79736E-01,-0.78139E-01,-0.76568E-01,-0.75022E-01, + &-0.73500E-01,-0.72002E-01,-0.70529E-01,-0.69079E-01,-0.67651E-01, + &-0.66247E-01,-0.64865E-01,-0.63505E-01,-0.62167E-01,-0.60850E-01, + &-0.59554E-01,-0.58278E-01,-0.57024E-01,-0.55789E-01,-0.54574E-01, + &-0.53379E-01,-0.52203E-01,-0.51046E-01,-0.49908E-01,-0.48788E-01, + &-0.47686E-01,-0.46602E-01,-0.45536E-01,-0.44487E-01,-0.43456E-01, + &-0.42441E-01,-0.41444E-01,-0.40462E-01,-0.39497E-01,-0.38548E-01, + &-0.37615E-01,-0.36698E-01,-0.35795E-01,-0.34909E-01,-0.34037E-01, + &-0.33180E-01,-0.32337E-01,-0.31509E-01,-0.30696E-01,-0.29896E-01, + &-0.29110E-01,-0.28338E-01,-0.27580E-01,-0.26835E-01,-0.26103E-01, + &-0.25384E-01,-0.24679E-01,-0.23986E-01,-0.23305E-01,-0.22637E-01, + &-0.21981E-01,-0.21338E-01,-0.20706E-01,-0.20086E-01,-0.19479E-01, + &-0.18882E-01,-0.18297E-01,-0.17724E-01,-0.17161E-01,-0.16610E-01, + &-0.16070E-01,-0.15540E-01,-0.15021E-01,-0.14513E-01,-0.14015E-01, + &-0.13528E-01,-0.13050E-01,-0.12583E-01,-0.12126E-01,-0.11679E-01, + &-0.11242E-01,-0.10814E-01,-0.10396E-01,-0.99873E-02,-0.95880E-02, + &-0.91981E-02,-0.88174E-02,-0.84457E-02,-0.80831E-02,-0.77294E-02/ + + DATA (BNC06M(I),I=701,741)/ + &-0.73845E-02,-0.70483E-02,-0.67207E-02,-0.64018E-02,-0.60913E-02, + &-0.57891E-02,-0.54953E-02,-0.52096E-02,-0.49322E-02,-0.46628E-02, + &-0.44013E-02,-0.41478E-02,-0.39020E-02,-0.36641E-02,-0.34337E-02, + &-0.32110E-02,-0.29958E-02,-0.27881E-02,-0.25878E-02,-0.23947E-02, + &-0.22090E-02,-0.20303E-02,-0.18589E-02,-0.16944E-02,-0.15369E-02, + &-0.13864E-02,-0.12427E-02,-0.11058E-02,-0.97562E-03,-0.85213E-03, + &-0.73527E-03,-0.62494E-03,-0.52106E-03,-0.42366E-03,-0.33266E-03, + &-0.24793E-03,-0.16948E-03,-0.97253E-04,-0.31242E-04, 0.28753E-04, + & 0.82669E-04 + & / +C +C *** (2H, SO4) +C + DATA (BNC07M (I),I= 1,100)/ + &-0.10557E+00,-0.19245E+00,-0.25372E+00,-0.29547E+00,-0.32770E+00, + &-0.35411E+00,-0.37657E+00,-0.39614E+00,-0.41351E+00,-0.42914E+00, + &-0.44335E+00,-0.45638E+00,-0.46842E+00,-0.47961E+00,-0.49007E+00, + &-0.49989E+00,-0.50915E+00,-0.51790E+00,-0.52620E+00,-0.53409E+00, + &-0.54162E+00,-0.54882E+00,-0.55571E+00,-0.56233E+00,-0.56868E+00, + &-0.57480E+00,-0.58070E+00,-0.58640E+00,-0.59191E+00,-0.59724E+00, + &-0.60240E+00,-0.60741E+00,-0.61227E+00,-0.61699E+00,-0.62158E+00, + &-0.62605E+00,-0.63041E+00,-0.63465E+00,-0.63879E+00,-0.64283E+00, + &-0.64677E+00,-0.65063E+00,-0.65440E+00,-0.65808E+00,-0.66169E+00, + &-0.66522E+00,-0.66869E+00,-0.67208E+00,-0.67540E+00,-0.67867E+00, + &-0.68187E+00,-0.68501E+00,-0.68810E+00,-0.69113E+00,-0.69411E+00, + &-0.69704E+00,-0.69992E+00,-0.70275E+00,-0.70554E+00,-0.70829E+00, + &-0.71099E+00,-0.71365E+00,-0.71628E+00,-0.71886E+00,-0.72141E+00, + &-0.72392E+00,-0.72640E+00,-0.72885E+00,-0.73126E+00,-0.73364E+00, + &-0.73600E+00,-0.73832E+00,-0.74061E+00,-0.74288E+00,-0.74512E+00, + &-0.74733E+00,-0.74952E+00,-0.75169E+00,-0.75383E+00,-0.75594E+00, + &-0.75804E+00,-0.76011E+00,-0.76216E+00,-0.76419E+00,-0.76621E+00, + &-0.76820E+00,-0.77017E+00,-0.77212E+00,-0.77406E+00,-0.77598E+00, + &-0.77788E+00,-0.77976E+00,-0.78163E+00,-0.78348E+00,-0.78532E+00, + &-0.78714E+00,-0.78894E+00,-0.79073E+00,-0.79251E+00,-0.79427E+00/ + + DATA (BNC07M (I),I=101,200)/ + &-0.79602E+00,-0.79775E+00,-0.79948E+00,-0.80118E+00,-0.80288E+00, + &-0.80456E+00,-0.80623E+00,-0.80789E+00,-0.80954E+00,-0.81117E+00, + &-0.81280E+00,-0.81441E+00,-0.81601E+00,-0.81760E+00,-0.81918E+00, + &-0.82074E+00,-0.82230E+00,-0.82385E+00,-0.82538E+00,-0.82691E+00, + &-0.82841E+00,-0.82992E+00,-0.83142E+00,-0.83291E+00,-0.83439E+00, + &-0.83586E+00,-0.83732E+00,-0.83877E+00,-0.84022E+00,-0.84165E+00, + &-0.84308E+00,-0.84449E+00,-0.84590E+00,-0.84730E+00,-0.84870E+00, + &-0.85008E+00,-0.85146E+00,-0.85283E+00,-0.85419E+00,-0.85554E+00, + &-0.85689E+00,-0.85823E+00,-0.85956E+00,-0.86088E+00,-0.86220E+00, + &-0.86351E+00,-0.86481E+00,-0.86611E+00,-0.86740E+00,-0.86868E+00, + &-0.86996E+00,-0.87123E+00,-0.87249E+00,-0.87375E+00,-0.87500E+00, + &-0.87625E+00,-0.87749E+00,-0.87872E+00,-0.87995E+00,-0.88117E+00, + &-0.88239E+00,-0.88360E+00,-0.88480E+00,-0.88600E+00,-0.88720E+00, + &-0.88839E+00,-0.88957E+00,-0.89075E+00,-0.89192E+00,-0.89309E+00, + &-0.89425E+00,-0.89541E+00,-0.89656E+00,-0.89771E+00,-0.89885E+00, + &-0.89999E+00,-0.90112E+00,-0.90225E+00,-0.90337E+00,-0.90449E+00, + &-0.90561E+00,-0.90672E+00,-0.90783E+00,-0.90893E+00,-0.91002E+00, + &-0.91112E+00,-0.91221E+00,-0.91329E+00,-0.91437E+00,-0.91545E+00, + &-0.91652E+00,-0.91759E+00,-0.91865E+00,-0.91971E+00,-0.92077E+00, + &-0.92182E+00,-0.92287E+00,-0.92392E+00,-0.92496E+00,-0.92600E+00/ + + DATA (BNC07M (I),I=201,300)/ + &-0.92703E+00,-0.92806E+00,-0.92909E+00,-0.93011E+00,-0.93113E+00, + &-0.93215E+00,-0.93316E+00,-0.93417E+00,-0.93518E+00,-0.93618E+00, + &-0.93718E+00,-0.93817E+00,-0.93917E+00,-0.94016E+00,-0.94114E+00, + &-0.94213E+00,-0.94311E+00,-0.94408E+00,-0.94506E+00,-0.94603E+00, + &-0.94700E+00,-0.94796E+00,-0.94892E+00,-0.94988E+00,-0.95084E+00, + &-0.95179E+00,-0.95274E+00,-0.95369E+00,-0.95463E+00,-0.95557E+00, + &-0.95651E+00,-0.95745E+00,-0.95838E+00,-0.95931E+00,-0.96024E+00, + &-0.96117E+00,-0.96209E+00,-0.96301E+00,-0.96393E+00,-0.96484E+00, + &-0.96576E+00,-0.96667E+00,-0.96758E+00,-0.96848E+00,-0.96938E+00, + &-0.97028E+00,-0.97118E+00,-0.97208E+00,-0.97297E+00,-0.97386E+00, + &-0.97475E+00,-0.97563E+00,-0.97652E+00,-0.97740E+00,-0.97828E+00, + &-0.97916E+00,-0.98003E+00,-0.98090E+00,-0.98177E+00,-0.98264E+00, + &-0.98351E+00,-0.98437E+00,-0.98523E+00,-0.98609E+00,-0.98695E+00, + &-0.98780E+00,-0.98866E+00,-0.98951E+00,-0.99036E+00,-0.99120E+00, + &-0.99205E+00,-0.99289E+00,-0.99373E+00,-0.99457E+00,-0.99541E+00, + &-0.99625E+00,-0.99708E+00,-0.99791E+00,-0.99874E+00,-0.99957E+00, + &-0.10004E+01,-0.10012E+01,-0.10020E+01,-0.10029E+01,-0.10037E+01, + &-0.10045E+01,-0.10053E+01,-0.10061E+01,-0.10069E+01,-0.10077E+01, + &-0.10086E+01,-0.10094E+01,-0.10102E+01,-0.10110E+01,-0.10118E+01, + &-0.10126E+01,-0.10134E+01,-0.10142E+01,-0.10150E+01,-0.10157E+01/ + + DATA (BNC07M (I),I=301,400)/ + &-0.10165E+01,-0.10173E+01,-0.10181E+01,-0.10189E+01,-0.10197E+01, + &-0.10205E+01,-0.10212E+01,-0.10220E+01,-0.10228E+01,-0.10236E+01, + &-0.10244E+01,-0.10251E+01,-0.10259E+01,-0.10267E+01,-0.10274E+01, + &-0.10282E+01,-0.10290E+01,-0.10297E+01,-0.10305E+01,-0.10313E+01, + &-0.10320E+01,-0.10328E+01,-0.10335E+01,-0.10343E+01,-0.10351E+01, + &-0.10358E+01,-0.10366E+01,-0.10373E+01,-0.10381E+01,-0.10388E+01, + &-0.10396E+01,-0.10403E+01,-0.10410E+01,-0.10418E+01,-0.10425E+01, + &-0.10433E+01,-0.10440E+01,-0.10447E+01,-0.10455E+01,-0.10462E+01, + &-0.10469E+01,-0.10477E+01,-0.10484E+01,-0.10491E+01,-0.10499E+01, + &-0.10506E+01,-0.10513E+01,-0.10520E+01,-0.10528E+01,-0.10535E+01, + &-0.10542E+01,-0.10549E+01,-0.10557E+01,-0.10564E+01,-0.10571E+01, + &-0.10578E+01,-0.10585E+01,-0.10592E+01,-0.10599E+01,-0.10606E+01, + &-0.10614E+01,-0.10621E+01,-0.10628E+01,-0.10635E+01,-0.10642E+01, + &-0.10649E+01,-0.10656E+01,-0.10663E+01,-0.10670E+01,-0.10677E+01, + &-0.10684E+01,-0.10691E+01,-0.10698E+01,-0.10705E+01,-0.10712E+01, + &-0.10719E+01,-0.10726E+01,-0.10733E+01,-0.10739E+01,-0.10746E+01, + &-0.10753E+01,-0.10760E+01,-0.10767E+01,-0.10774E+01,-0.10781E+01, + &-0.10787E+01,-0.10794E+01,-0.10801E+01,-0.10808E+01,-0.10815E+01, + &-0.10821E+01,-0.10828E+01,-0.10835E+01,-0.10842E+01,-0.10848E+01, + &-0.10855E+01,-0.10862E+01,-0.10869E+01,-0.10875E+01,-0.10882E+01/ + + DATA (BNC07M (I),I=401,500)/ + &-0.10889E+01,-0.10895E+01,-0.10902E+01,-0.10909E+01,-0.10915E+01, + &-0.10922E+01,-0.10929E+01,-0.10935E+01,-0.10942E+01,-0.10948E+01, + &-0.10955E+01,-0.10962E+01,-0.10968E+01,-0.10975E+01,-0.10981E+01, + &-0.10988E+01,-0.10994E+01,-0.11001E+01,-0.11008E+01,-0.11014E+01, + &-0.11021E+01,-0.11027E+01,-0.11034E+01,-0.11040E+01,-0.11047E+01, + &-0.11053E+01,-0.11059E+01,-0.11066E+01,-0.11072E+01,-0.11079E+01, + &-0.11085E+01,-0.11092E+01,-0.11098E+01,-0.11104E+01,-0.11111E+01, + &-0.11117E+01,-0.11124E+01,-0.11130E+01,-0.11136E+01,-0.11143E+01, + &-0.11149E+01,-0.11155E+01,-0.11162E+01,-0.11168E+01,-0.11174E+01, + &-0.11181E+01,-0.11187E+01,-0.11193E+01,-0.11200E+01,-0.11206E+01, + &-0.11212E+01,-0.11218E+01,-0.11225E+01,-0.11231E+01,-0.11237E+01, + &-0.11243E+01,-0.11250E+01,-0.11256E+01,-0.11262E+01,-0.11268E+01, + &-0.11274E+01,-0.11281E+01,-0.11287E+01,-0.11293E+01,-0.11299E+01, + &-0.11305E+01,-0.11312E+01,-0.11318E+01,-0.11324E+01,-0.11330E+01, + &-0.11336E+01,-0.11342E+01,-0.11348E+01,-0.11355E+01,-0.11361E+01, + &-0.11367E+01,-0.11373E+01,-0.11379E+01,-0.11385E+01,-0.11391E+01, + &-0.11397E+01,-0.11403E+01,-0.11409E+01,-0.11415E+01,-0.11421E+01, + &-0.11427E+01,-0.11433E+01,-0.11439E+01,-0.11445E+01,-0.11451E+01, + &-0.11457E+01,-0.11463E+01,-0.11469E+01,-0.11475E+01,-0.11481E+01, + &-0.11487E+01,-0.11493E+01,-0.11499E+01,-0.11505E+01,-0.11511E+01/ + + DATA (BNC07M (I),I=501,600)/ + &-0.11517E+01,-0.11523E+01,-0.11529E+01,-0.11535E+01,-0.11541E+01, + &-0.11547E+01,-0.11553E+01,-0.11559E+01,-0.11565E+01,-0.11570E+01, + &-0.11576E+01,-0.11582E+01,-0.11588E+01,-0.11594E+01,-0.11600E+01, + &-0.11606E+01,-0.11612E+01,-0.11617E+01,-0.11623E+01,-0.11629E+01, + &-0.11635E+01,-0.11641E+01,-0.11647E+01,-0.11652E+01,-0.11658E+01, + &-0.11664E+01,-0.11670E+01,-0.11676E+01,-0.11681E+01,-0.11687E+01, + &-0.11693E+01,-0.11699E+01,-0.11704E+01,-0.11710E+01,-0.11716E+01, + &-0.11722E+01,-0.11728E+01,-0.11733E+01,-0.11739E+01,-0.11745E+01, + &-0.11750E+01,-0.11756E+01,-0.11762E+01,-0.11768E+01,-0.11773E+01, + &-0.11779E+01,-0.11785E+01,-0.11790E+01,-0.11796E+01,-0.11802E+01, + &-0.11807E+01,-0.11813E+01,-0.11819E+01,-0.11824E+01,-0.11830E+01, + &-0.11836E+01,-0.11841E+01,-0.11847E+01,-0.11853E+01,-0.11858E+01, + &-0.11864E+01,-0.11870E+01,-0.11875E+01,-0.11881E+01,-0.11886E+01, + &-0.11892E+01,-0.11898E+01,-0.11903E+01,-0.11909E+01,-0.11914E+01, + &-0.11920E+01,-0.11925E+01,-0.11931E+01,-0.11937E+01,-0.11942E+01, + &-0.11948E+01,-0.11953E+01,-0.11959E+01,-0.11964E+01,-0.11970E+01, + &-0.11975E+01,-0.11981E+01,-0.11987E+01,-0.11992E+01,-0.11998E+01, + &-0.12003E+01,-0.12009E+01,-0.12014E+01,-0.12020E+01,-0.12025E+01, + &-0.12031E+01,-0.12036E+01,-0.12042E+01,-0.12047E+01,-0.12053E+01, + &-0.12058E+01,-0.12063E+01,-0.12069E+01,-0.12074E+01,-0.12095E+01/ + + DATA (BNC07M (I),I=601,700)/ + &-0.12140E+01,-0.12193E+01,-0.12247E+01,-0.12300E+01,-0.12353E+01, + &-0.12405E+01,-0.12457E+01,-0.12509E+01,-0.12560E+01,-0.12611E+01, + &-0.12662E+01,-0.12712E+01,-0.12763E+01,-0.12812E+01,-0.12862E+01, + &-0.12911E+01,-0.12960E+01,-0.13009E+01,-0.13058E+01,-0.13106E+01, + &-0.13154E+01,-0.13202E+01,-0.13250E+01,-0.13297E+01,-0.13344E+01, + &-0.13391E+01,-0.13438E+01,-0.13484E+01,-0.13531E+01,-0.13577E+01, + &-0.13623E+01,-0.13669E+01,-0.13714E+01,-0.13760E+01,-0.13805E+01, + &-0.13850E+01,-0.13895E+01,-0.13940E+01,-0.13984E+01,-0.14029E+01, + &-0.14073E+01,-0.14117E+01,-0.14161E+01,-0.14205E+01,-0.14249E+01, + &-0.14292E+01,-0.14336E+01,-0.14379E+01,-0.14422E+01,-0.14465E+01, + &-0.14508E+01,-0.14551E+01,-0.14593E+01,-0.14636E+01,-0.14678E+01, + &-0.14720E+01,-0.14763E+01,-0.14805E+01,-0.14847E+01,-0.14888E+01, + &-0.14930E+01,-0.14972E+01,-0.15013E+01,-0.15055E+01,-0.15096E+01, + &-0.15137E+01,-0.15178E+01,-0.15219E+01,-0.15260E+01,-0.15301E+01, + &-0.15341E+01,-0.15382E+01,-0.15423E+01,-0.15463E+01,-0.15503E+01, + &-0.15544E+01,-0.15584E+01,-0.15624E+01,-0.15664E+01,-0.15704E+01, + &-0.15744E+01,-0.15783E+01,-0.15823E+01,-0.15863E+01,-0.15902E+01, + &-0.15941E+01,-0.15981E+01,-0.16020E+01,-0.16059E+01,-0.16098E+01, + &-0.16138E+01,-0.16176E+01,-0.16215E+01,-0.16254E+01,-0.16293E+01, + &-0.16332E+01,-0.16370E+01,-0.16409E+01,-0.16448E+01,-0.16486E+01/ + + DATA (BNC07M(I),I=701,741)/ + &-0.16524E+01,-0.16563E+01,-0.16601E+01,-0.16639E+01,-0.16677E+01, + &-0.16715E+01,-0.16753E+01,-0.16791E+01,-0.16829E+01,-0.16867E+01, + &-0.16905E+01,-0.16943E+01,-0.16980E+01,-0.17018E+01,-0.17055E+01, + &-0.17093E+01,-0.17130E+01,-0.17168E+01,-0.17205E+01,-0.17243E+01, + &-0.17280E+01,-0.17317E+01,-0.17354E+01,-0.17391E+01,-0.17428E+01, + &-0.17465E+01,-0.17502E+01,-0.17539E+01,-0.17576E+01,-0.17613E+01, + &-0.17650E+01,-0.17686E+01,-0.17723E+01,-0.17760E+01,-0.17796E+01, + &-0.17833E+01,-0.17869E+01,-0.17906E+01,-0.17942E+01,-0.17978E+01, + &-0.18015E+01 + & / +C +C *** (H, HSO4) +C + DATA (BNC08M (I),I= 1,100)/ + &-0.49133E-01,-0.83570E-01,-0.10389E+00,-0.11538E+00,-0.12265E+00, + &-0.12736E+00,-0.13032E+00,-0.13201E+00,-0.13270E+00,-0.13259E+00, + &-0.13182E+00,-0.13049E+00,-0.12867E+00,-0.12642E+00,-0.12378E+00, + &-0.12080E+00,-0.11750E+00,-0.11391E+00,-0.11005E+00,-0.10594E+00, + &-0.10160E+00,-0.97035E-01,-0.92266E-01,-0.87301E-01,-0.82151E-01, + &-0.76825E-01,-0.71330E-01,-0.65676E-01,-0.59869E-01,-0.53917E-01, + &-0.47824E-01,-0.41599E-01,-0.35245E-01,-0.28770E-01,-0.22177E-01, + &-0.15472E-01,-0.86592E-02,-0.17436E-02, 0.52706E-02, 0.12379E-01, + & 0.19579E-01, 0.26864E-01, 0.34233E-01, 0.41682E-01, 0.49206E-01, + & 0.56803E-01, 0.64470E-01, 0.72204E-01, 0.80002E-01, 0.87862E-01, + & 0.95780E-01, 0.10376E+00, 0.11179E+00, 0.11987E+00, 0.12800E+00, + & 0.13618E+00, 0.14441E+00, 0.15269E+00, 0.16101E+00, 0.16938E+00, + & 0.17779E+00, 0.18624E+00, 0.19473E+00, 0.20327E+00, 0.21184E+00, + & 0.22046E+00, 0.22912E+00, 0.23782E+00, 0.24656E+00, 0.25534E+00, + & 0.26416E+00, 0.27303E+00, 0.28194E+00, 0.29089E+00, 0.29989E+00, + & 0.30893E+00, 0.31802E+00, 0.32715E+00, 0.33633E+00, 0.34556E+00, + & 0.35483E+00, 0.36415E+00, 0.37353E+00, 0.38295E+00, 0.39242E+00, + & 0.40194E+00, 0.41151E+00, 0.42113E+00, 0.43079E+00, 0.44051E+00, + & 0.45028E+00, 0.46009E+00, 0.46995E+00, 0.47986E+00, 0.48982E+00, + & 0.49981E+00, 0.50986E+00, 0.51994E+00, 0.53006E+00, 0.54023E+00/ + + DATA (BNC08M (I),I=101,200)/ + & 0.55043E+00, 0.56067E+00, 0.57094E+00, 0.58125E+00, 0.59158E+00, + & 0.60195E+00, 0.61234E+00, 0.62276E+00, 0.63320E+00, 0.64367E+00, + & 0.65415E+00, 0.66465E+00, 0.67516E+00, 0.68569E+00, 0.69624E+00, + & 0.70679E+00, 0.71735E+00, 0.72792E+00, 0.73849E+00, 0.74907E+00, + & 0.75876E+00, 0.76945E+00, 0.78012E+00, 0.79078E+00, 0.80143E+00, + & 0.81207E+00, 0.82269E+00, 0.83330E+00, 0.84390E+00, 0.85449E+00, + & 0.86506E+00, 0.87561E+00, 0.88616E+00, 0.89668E+00, 0.90719E+00, + & 0.91769E+00, 0.92817E+00, 0.93863E+00, 0.94908E+00, 0.95951E+00, + & 0.96993E+00, 0.98032E+00, 0.99070E+00, 0.10011E+01, 0.10114E+01, + & 0.10217E+01, 0.10320E+01, 0.10423E+01, 0.10526E+01, 0.10629E+01, + & 0.10731E+01, 0.10833E+01, 0.10935E+01, 0.11037E+01, 0.11138E+01, + & 0.11240E+01, 0.11341E+01, 0.11442E+01, 0.11543E+01, 0.11644E+01, + & 0.11744E+01, 0.11844E+01, 0.11944E+01, 0.12044E+01, 0.12144E+01, + & 0.12243E+01, 0.12342E+01, 0.12441E+01, 0.12540E+01, 0.12639E+01, + & 0.12737E+01, 0.12835E+01, 0.12933E+01, 0.13031E+01, 0.13129E+01, + & 0.13226E+01, 0.13323E+01, 0.13420E+01, 0.13517E+01, 0.13614E+01, + & 0.13710E+01, 0.13806E+01, 0.13902E+01, 0.13998E+01, 0.14093E+01, + & 0.14189E+01, 0.14284E+01, 0.14379E+01, 0.14474E+01, 0.14568E+01, + & 0.14662E+01, 0.14756E+01, 0.14850E+01, 0.14944E+01, 0.15038E+01, + & 0.15131E+01, 0.15224E+01, 0.15317E+01, 0.15410E+01, 0.15502E+01/ + + DATA (BNC08M (I),I=201,300)/ + & 0.15594E+01, 0.15687E+01, 0.15778E+01, 0.15870E+01, 0.15962E+01, + & 0.16053E+01, 0.16144E+01, 0.16235E+01, 0.16326E+01, 0.16416E+01, + & 0.16507E+01, 0.16597E+01, 0.16687E+01, 0.16776E+01, 0.16866E+01, + & 0.16955E+01, 0.17044E+01, 0.17133E+01, 0.17222E+01, 0.17311E+01, + & 0.17399E+01, 0.17487E+01, 0.17575E+01, 0.17663E+01, 0.17751E+01, + & 0.17838E+01, 0.17925E+01, 0.18012E+01, 0.18099E+01, 0.18186E+01, + & 0.18272E+01, 0.18359E+01, 0.18445E+01, 0.18531E+01, 0.18616E+01, + & 0.18702E+01, 0.18787E+01, 0.18872E+01, 0.18958E+01, 0.19042E+01, + & 0.19127E+01, 0.19211E+01, 0.19296E+01, 0.19380E+01, 0.19464E+01, + & 0.19548E+01, 0.19631E+01, 0.19715E+01, 0.19798E+01, 0.19881E+01, + & 0.19964E+01, 0.20046E+01, 0.20129E+01, 0.20211E+01, 0.20293E+01, + & 0.20375E+01, 0.20457E+01, 0.20539E+01, 0.20620E+01, 0.20702E+01, + & 0.20783E+01, 0.20864E+01, 0.20945E+01, 0.21025E+01, 0.21106E+01, + & 0.21186E+01, 0.21266E+01, 0.21346E+01, 0.21426E+01, 0.21506E+01, + & 0.21585E+01, 0.21665E+01, 0.21744E+01, 0.21823E+01, 0.21902E+01, + & 0.21980E+01, 0.22059E+01, 0.22137E+01, 0.22215E+01, 0.22294E+01, + & 0.22371E+01, 0.22449E+01, 0.22527E+01, 0.22604E+01, 0.22681E+01, + & 0.22759E+01, 0.22835E+01, 0.22912E+01, 0.22989E+01, 0.23065E+01, + & 0.23142E+01, 0.23218E+01, 0.23294E+01, 0.23370E+01, 0.23446E+01, + & 0.23521E+01, 0.23597E+01, 0.23672E+01, 0.23747E+01, 0.23822E+01/ + + DATA (BNC08M (I),I=301,400)/ + & 0.23897E+01, 0.23972E+01, 0.24046E+01, 0.24121E+01, 0.24195E+01, + & 0.24269E+01, 0.24343E+01, 0.24417E+01, 0.24490E+01, 0.24564E+01, + & 0.24637E+01, 0.24711E+01, 0.24784E+01, 0.24857E+01, 0.24930E+01, + & 0.25002E+01, 0.25075E+01, 0.25147E+01, 0.25220E+01, 0.25292E+01, + & 0.25364E+01, 0.25436E+01, 0.25507E+01, 0.25579E+01, 0.25650E+01, + & 0.25722E+01, 0.25793E+01, 0.25864E+01, 0.25935E+01, 0.26006E+01, + & 0.26076E+01, 0.26147E+01, 0.26217E+01, 0.26288E+01, 0.26358E+01, + & 0.26428E+01, 0.26498E+01, 0.26567E+01, 0.26637E+01, 0.26706E+01, + & 0.26776E+01, 0.26845E+01, 0.26914E+01, 0.26983E+01, 0.27052E+01, + & 0.27121E+01, 0.27189E+01, 0.27258E+01, 0.27326E+01, 0.27394E+01, + & 0.27463E+01, 0.27531E+01, 0.27598E+01, 0.27666E+01, 0.27734E+01, + & 0.27801E+01, 0.27869E+01, 0.27936E+01, 0.28003E+01, 0.28070E+01, + & 0.28137E+01, 0.28204E+01, 0.28270E+01, 0.28337E+01, 0.28403E+01, + & 0.28470E+01, 0.28536E+01, 0.28602E+01, 0.28668E+01, 0.28734E+01, + & 0.28799E+01, 0.28865E+01, 0.28930E+01, 0.28996E+01, 0.29061E+01, + & 0.29126E+01, 0.29191E+01, 0.29256E+01, 0.29321E+01, 0.29386E+01, + & 0.29450E+01, 0.29515E+01, 0.29579E+01, 0.29643E+01, 0.29708E+01, + & 0.29772E+01, 0.29835E+01, 0.29899E+01, 0.29963E+01, 0.30027E+01, + & 0.30090E+01, 0.30153E+01, 0.30217E+01, 0.30280E+01, 0.30343E+01, + & 0.30406E+01, 0.30469E+01, 0.30531E+01, 0.30594E+01, 0.30657E+01/ + + DATA (BNC08M (I),I=401,500)/ + & 0.30719E+01, 0.30781E+01, 0.30844E+01, 0.30906E+01, 0.30968E+01, + & 0.31030E+01, 0.31091E+01, 0.31153E+01, 0.31215E+01, 0.31276E+01, + & 0.31338E+01, 0.31399E+01, 0.31460E+01, 0.31521E+01, 0.31582E+01, + & 0.31643E+01, 0.31704E+01, 0.31764E+01, 0.31825E+01, 0.31886E+01, + & 0.31946E+01, 0.32006E+01, 0.32066E+01, 0.32127E+01, 0.32187E+01, + & 0.32246E+01, 0.32306E+01, 0.32366E+01, 0.32426E+01, 0.32485E+01, + & 0.32545E+01, 0.32604E+01, 0.32663E+01, 0.32722E+01, 0.32781E+01, + & 0.32840E+01, 0.32899E+01, 0.32958E+01, 0.33017E+01, 0.33075E+01, + & 0.33134E+01, 0.33192E+01, 0.33250E+01, 0.33309E+01, 0.33367E+01, + & 0.33425E+01, 0.33483E+01, 0.33540E+01, 0.33598E+01, 0.33656E+01, + & 0.33713E+01, 0.33771E+01, 0.33828E+01, 0.33886E+01, 0.33943E+01, + & 0.34000E+01, 0.34057E+01, 0.34114E+01, 0.34171E+01, 0.34228E+01, + & 0.34284E+01, 0.34341E+01, 0.34397E+01, 0.34454E+01, 0.34510E+01, + & 0.34567E+01, 0.34623E+01, 0.34679E+01, 0.34735E+01, 0.34791E+01, + & 0.34847E+01, 0.34902E+01, 0.34958E+01, 0.35014E+01, 0.35069E+01, + & 0.35124E+01, 0.35180E+01, 0.35235E+01, 0.35290E+01, 0.35345E+01, + & 0.35400E+01, 0.35455E+01, 0.35510E+01, 0.35565E+01, 0.35620E+01, + & 0.35674E+01, 0.35729E+01, 0.35783E+01, 0.35837E+01, 0.35892E+01, + & 0.35946E+01, 0.36000E+01, 0.36054E+01, 0.36108E+01, 0.36162E+01, + & 0.36216E+01, 0.36269E+01, 0.36323E+01, 0.36377E+01, 0.36430E+01/ + + DATA (BNC08M (I),I=501,600)/ + & 0.36483E+01, 0.36537E+01, 0.36590E+01, 0.36643E+01, 0.36696E+01, + & 0.36749E+01, 0.36802E+01, 0.36855E+01, 0.36908E+01, 0.36961E+01, + & 0.37013E+01, 0.37066E+01, 0.37118E+01, 0.37171E+01, 0.37223E+01, + & 0.37275E+01, 0.37328E+01, 0.37380E+01, 0.37432E+01, 0.37484E+01, + & 0.37536E+01, 0.37588E+01, 0.37639E+01, 0.37691E+01, 0.37743E+01, + & 0.37794E+01, 0.37846E+01, 0.37897E+01, 0.37948E+01, 0.38000E+01, + & 0.38051E+01, 0.38102E+01, 0.38153E+01, 0.38204E+01, 0.38255E+01, + & 0.38305E+01, 0.38356E+01, 0.38407E+01, 0.38458E+01, 0.38508E+01, + & 0.38559E+01, 0.38609E+01, 0.38659E+01, 0.38710E+01, 0.38760E+01, + & 0.38810E+01, 0.38860E+01, 0.38910E+01, 0.38960E+01, 0.39010E+01, + & 0.39059E+01, 0.39109E+01, 0.39159E+01, 0.39208E+01, 0.39258E+01, + & 0.39307E+01, 0.39357E+01, 0.39406E+01, 0.39455E+01, 0.39504E+01, + & 0.39554E+01, 0.39603E+01, 0.39652E+01, 0.39701E+01, 0.39749E+01, + & 0.39798E+01, 0.39847E+01, 0.39896E+01, 0.39944E+01, 0.39993E+01, + & 0.40041E+01, 0.40090E+01, 0.40138E+01, 0.40186E+01, 0.40234E+01, + & 0.40283E+01, 0.40331E+01, 0.40379E+01, 0.40427E+01, 0.40475E+01, + & 0.40522E+01, 0.40570E+01, 0.40618E+01, 0.40665E+01, 0.40713E+01, + & 0.40761E+01, 0.40808E+01, 0.40855E+01, 0.40903E+01, 0.40950E+01, + & 0.40997E+01, 0.41044E+01, 0.41091E+01, 0.41138E+01, 0.41185E+01, + & 0.41232E+01, 0.41279E+01, 0.41326E+01, 0.41373E+01, 0.41547E+01/ + + DATA (BNC08M (I),I=601,700)/ + & 0.41929E+01, 0.42386E+01, 0.42837E+01, 0.43283E+01, 0.43723E+01, + & 0.44159E+01, 0.44588E+01, 0.45013E+01, 0.45433E+01, 0.45849E+01, + & 0.46259E+01, 0.46665E+01, 0.47066E+01, 0.47463E+01, 0.47856E+01, + & 0.48244E+01, 0.48628E+01, 0.49008E+01, 0.49384E+01, 0.49757E+01, + & 0.50125E+01, 0.50490E+01, 0.50851E+01, 0.51208E+01, 0.51562E+01, + & 0.51912E+01, 0.52259E+01, 0.52603E+01, 0.52943E+01, 0.53280E+01, + & 0.53614E+01, 0.53945E+01, 0.54273E+01, 0.54598E+01, 0.54919E+01, + & 0.55238E+01, 0.55554E+01, 0.55868E+01, 0.56178E+01, 0.56486E+01, + & 0.56791E+01, 0.57094E+01, 0.57394E+01, 0.57691E+01, 0.57986E+01, + & 0.58279E+01, 0.58569E+01, 0.58856E+01, 0.59142E+01, 0.59425E+01, + & 0.59705E+01, 0.59984E+01, 0.60260E+01, 0.60534E+01, 0.60807E+01, + & 0.61076E+01, 0.61344E+01, 0.61610E+01, 0.61874E+01, 0.62136E+01, + & 0.62396E+01, 0.62653E+01, 0.62909E+01, 0.63164E+01, 0.63416E+01, + & 0.63666E+01, 0.63915E+01, 0.64162E+01, 0.64407E+01, 0.64650E+01, + & 0.64892E+01, 0.65132E+01, 0.65370E+01, 0.65607E+01, 0.65842E+01, + & 0.66076E+01, 0.66308E+01, 0.66538E+01, 0.66767E+01, 0.66994E+01, + & 0.67220E+01, 0.67444E+01, 0.67667E+01, 0.67889E+01, 0.68108E+01, + & 0.68327E+01, 0.68544E+01, 0.68760E+01, 0.68974E+01, 0.69188E+01, + & 0.69399E+01, 0.69610E+01, 0.69819E+01, 0.70027E+01, 0.70233E+01, + & 0.70439E+01, 0.70643E+01, 0.70846E+01, 0.71047E+01, 0.71248E+01/ + + DATA (BNC08M(I),I=701,741)/ + & 0.71447E+01, 0.71645E+01, 0.71842E+01, 0.72038E+01, 0.72233E+01, + & 0.72426E+01, 0.72619E+01, 0.72810E+01, 0.73000E+01, 0.73189E+01, + & 0.73378E+01, 0.73565E+01, 0.73751E+01, 0.73936E+01, 0.74120E+01, + & 0.74303E+01, 0.74484E+01, 0.74665E+01, 0.74845E+01, 0.75024E+01, + & 0.75203E+01, 0.75380E+01, 0.75556E+01, 0.75731E+01, 0.75905E+01, + & 0.76079E+01, 0.76251E+01, 0.76423E+01, 0.76593E+01, 0.76763E+01, + & 0.76932E+01, 0.77100E+01, 0.77268E+01, 0.77434E+01, 0.77600E+01, + & 0.77764E+01, 0.77928E+01, 0.78091E+01, 0.78253E+01, 0.78415E+01, + & 0.78576E+01 + & / +C +C *** NH4HSO4 +C + DATA (BNC09M (I),I= 1,100)/ + &-0.51701E-01,-0.92605E-01,-0.12047E+00,-0.13892E+00,-0.15280E+00, + &-0.16389E+00,-0.17309E+00,-0.18091E+00,-0.18765E+00,-0.19355E+00, + &-0.19875E+00,-0.20336E+00,-0.20748E+00,-0.21116E+00,-0.21445E+00, + &-0.21741E+00,-0.22006E+00,-0.22244E+00,-0.22456E+00,-0.22646E+00, + &-0.22813E+00,-0.22961E+00,-0.23090E+00,-0.23202E+00,-0.23297E+00, + &-0.23377E+00,-0.23442E+00,-0.23493E+00,-0.23531E+00,-0.23556E+00, + &-0.23569E+00,-0.23570E+00,-0.23561E+00,-0.23540E+00,-0.23510E+00, + &-0.23469E+00,-0.23419E+00,-0.23360E+00,-0.23293E+00,-0.23217E+00, + &-0.23132E+00,-0.23040E+00,-0.22941E+00,-0.22834E+00,-0.22720E+00, + &-0.22599E+00,-0.22471E+00,-0.22338E+00,-0.22198E+00,-0.22052E+00, + &-0.21901E+00,-0.21744E+00,-0.21582E+00,-0.21415E+00,-0.21242E+00, + &-0.21065E+00,-0.20884E+00,-0.20697E+00,-0.20507E+00,-0.20312E+00, + &-0.20113E+00,-0.19910E+00,-0.19703E+00,-0.19493E+00,-0.19278E+00, + &-0.19060E+00,-0.18839E+00,-0.18614E+00,-0.18386E+00,-0.18154E+00, + &-0.17919E+00,-0.17681E+00,-0.17440E+00,-0.17196E+00,-0.16948E+00, + &-0.16698E+00,-0.16445E+00,-0.16188E+00,-0.15929E+00,-0.15667E+00, + &-0.15402E+00,-0.15134E+00,-0.14864E+00,-0.14590E+00,-0.14314E+00, + &-0.14035E+00,-0.13754E+00,-0.13470E+00,-0.13183E+00,-0.12894E+00, + &-0.12602E+00,-0.12308E+00,-0.12011E+00,-0.11713E+00,-0.11411E+00, + &-0.11108E+00,-0.10803E+00,-0.10495E+00,-0.10186E+00,-0.98742E-01/ + + DATA (BNC09M (I),I=101,200)/ + &-0.95609E-01,-0.92458E-01,-0.89291E-01,-0.86108E-01,-0.82909E-01, + &-0.79696E-01,-0.76469E-01,-0.73230E-01,-0.69979E-01,-0.66717E-01, + &-0.63445E-01,-0.60163E-01,-0.56873E-01,-0.53575E-01,-0.50270E-01, + &-0.46959E-01,-0.43642E-01,-0.40321E-01,-0.36995E-01,-0.33666E-01, + &-0.30646E-01,-0.27276E-01,-0.23908E-01,-0.20542E-01,-0.17179E-01, + &-0.13818E-01,-0.10461E-01,-0.71064E-02,-0.37554E-02,-0.40779E-03, + & 0.29358E-02, 0.62756E-02, 0.96112E-02, 0.12942E-01, 0.16269E-01, + & 0.19592E-01, 0.22909E-01, 0.26221E-01, 0.29529E-01, 0.32832E-01, + & 0.36129E-01, 0.39420E-01, 0.42706E-01, 0.45987E-01, 0.49262E-01, + & 0.52531E-01, 0.55794E-01, 0.59051E-01, 0.62303E-01, 0.65548E-01, + & 0.68786E-01, 0.72019E-01, 0.75245E-01, 0.78465E-01, 0.81678E-01, + & 0.84885E-01, 0.88086E-01, 0.91279E-01, 0.94466E-01, 0.97647E-01, + & 0.10082E+00, 0.10399E+00, 0.10715E+00, 0.11030E+00, 0.11345E+00, + & 0.11659E+00, 0.11972E+00, 0.12285E+00, 0.12596E+00, 0.12908E+00, + & 0.13218E+00, 0.13528E+00, 0.13837E+00, 0.14146E+00, 0.14453E+00, + & 0.14760E+00, 0.15067E+00, 0.15372E+00, 0.15677E+00, 0.15981E+00, + & 0.16285E+00, 0.16588E+00, 0.16890E+00, 0.17191E+00, 0.17492E+00, + & 0.17792E+00, 0.18091E+00, 0.18390E+00, 0.18688E+00, 0.18985E+00, + & 0.19281E+00, 0.19577E+00, 0.19872E+00, 0.20167E+00, 0.20460E+00, + & 0.20753E+00, 0.21046E+00, 0.21338E+00, 0.21629E+00, 0.21919E+00/ + + DATA (BNC09M (I),I=201,300)/ + & 0.22208E+00, 0.22497E+00, 0.22786E+00, 0.23073E+00, 0.23360E+00, + & 0.23647E+00, 0.23932E+00, 0.24217E+00, 0.24501E+00, 0.24785E+00, + & 0.25068E+00, 0.25350E+00, 0.25632E+00, 0.25913E+00, 0.26193E+00, + & 0.26473E+00, 0.26752E+00, 0.27030E+00, 0.27308E+00, 0.27585E+00, + & 0.27861E+00, 0.28137E+00, 0.28412E+00, 0.28687E+00, 0.28961E+00, + & 0.29234E+00, 0.29506E+00, 0.29778E+00, 0.30050E+00, 0.30321E+00, + & 0.30591E+00, 0.30860E+00, 0.31129E+00, 0.31397E+00, 0.31665E+00, + & 0.31932E+00, 0.32199E+00, 0.32465E+00, 0.32730E+00, 0.32995E+00, + & 0.33259E+00, 0.33522E+00, 0.33785E+00, 0.34047E+00, 0.34309E+00, + & 0.34570E+00, 0.34831E+00, 0.35091E+00, 0.35350E+00, 0.35609E+00, + & 0.35867E+00, 0.36125E+00, 0.36382E+00, 0.36639E+00, 0.36895E+00, + & 0.37150E+00, 0.37405E+00, 0.37659E+00, 0.37913E+00, 0.38166E+00, + & 0.38419E+00, 0.38671E+00, 0.38923E+00, 0.39174E+00, 0.39424E+00, + & 0.39674E+00, 0.39924E+00, 0.40173E+00, 0.40421E+00, 0.40669E+00, + & 0.40916E+00, 0.41163E+00, 0.41409E+00, 0.41655E+00, 0.41900E+00, + & 0.42145E+00, 0.42389E+00, 0.42632E+00, 0.42876E+00, 0.43118E+00, + & 0.43360E+00, 0.43602E+00, 0.43843E+00, 0.44084E+00, 0.44324E+00, + & 0.44563E+00, 0.44803E+00, 0.45041E+00, 0.45279E+00, 0.45517E+00, + & 0.45754E+00, 0.45991E+00, 0.46227E+00, 0.46463E+00, 0.46698E+00, + & 0.46933E+00, 0.47167E+00, 0.47401E+00, 0.47634E+00, 0.47867E+00/ + + DATA (BNC09M (I),I=301,400)/ + & 0.48099E+00, 0.48331E+00, 0.48563E+00, 0.48794E+00, 0.49024E+00, + & 0.49254E+00, 0.49484E+00, 0.49713E+00, 0.49942E+00, 0.50170E+00, + & 0.50398E+00, 0.50625E+00, 0.50852E+00, 0.51079E+00, 0.51305E+00, + & 0.51530E+00, 0.51755E+00, 0.51980E+00, 0.52204E+00, 0.52428E+00, + & 0.52651E+00, 0.52874E+00, 0.53097E+00, 0.53319E+00, 0.53540E+00, + & 0.53762E+00, 0.53983E+00, 0.54203E+00, 0.54423E+00, 0.54642E+00, + & 0.54862E+00, 0.55080E+00, 0.55299E+00, 0.55516E+00, 0.55734E+00, + & 0.55951E+00, 0.56168E+00, 0.56384E+00, 0.56600E+00, 0.56815E+00, + & 0.57030E+00, 0.57245E+00, 0.57459E+00, 0.57673E+00, 0.57886E+00, + & 0.58099E+00, 0.58312E+00, 0.58524E+00, 0.58736E+00, 0.58947E+00, + & 0.59158E+00, 0.59369E+00, 0.59579E+00, 0.59789E+00, 0.59999E+00, + & 0.60208E+00, 0.60416E+00, 0.60625E+00, 0.60833E+00, 0.61040E+00, + & 0.61248E+00, 0.61455E+00, 0.61661E+00, 0.61867E+00, 0.62073E+00, + & 0.62278E+00, 0.62483E+00, 0.62688E+00, 0.62892E+00, 0.63096E+00, + & 0.63300E+00, 0.63503E+00, 0.63706E+00, 0.63908E+00, 0.64110E+00, + & 0.64312E+00, 0.64513E+00, 0.64714E+00, 0.64915E+00, 0.65115E+00, + & 0.65316E+00, 0.65515E+00, 0.65714E+00, 0.65913E+00, 0.66112E+00, + & 0.66310E+00, 0.66508E+00, 0.66706E+00, 0.66903E+00, 0.67100E+00, + & 0.67296E+00, 0.67492E+00, 0.67688E+00, 0.67884E+00, 0.68079E+00, + & 0.68274E+00, 0.68468E+00, 0.68663E+00, 0.68856E+00, 0.69050E+00/ + + DATA (BNC09M (I),I=401,500)/ + & 0.69243E+00, 0.69436E+00, 0.69629E+00, 0.69821E+00, 0.70013E+00, + & 0.70204E+00, 0.70396E+00, 0.70587E+00, 0.70777E+00, 0.70967E+00, + & 0.71157E+00, 0.71347E+00, 0.71536E+00, 0.71725E+00, 0.71914E+00, + & 0.72103E+00, 0.72291E+00, 0.72478E+00, 0.72666E+00, 0.72853E+00, + & 0.73040E+00, 0.73226E+00, 0.73413E+00, 0.73599E+00, 0.73784E+00, + & 0.73970E+00, 0.74155E+00, 0.74339E+00, 0.74524E+00, 0.74708E+00, + & 0.74892E+00, 0.75075E+00, 0.75258E+00, 0.75441E+00, 0.75624E+00, + & 0.75806E+00, 0.75988E+00, 0.76170E+00, 0.76352E+00, 0.76533E+00, + & 0.76714E+00, 0.76894E+00, 0.77074E+00, 0.77255E+00, 0.77434E+00, + & 0.77614E+00, 0.77793E+00, 0.77972E+00, 0.78150E+00, 0.78329E+00, + & 0.78507E+00, 0.78684E+00, 0.78862E+00, 0.79039E+00, 0.79216E+00, + & 0.79393E+00, 0.79569E+00, 0.79745E+00, 0.79921E+00, 0.80096E+00, + & 0.80272E+00, 0.80447E+00, 0.80621E+00, 0.80796E+00, 0.80970E+00, + & 0.81144E+00, 0.81318E+00, 0.81491E+00, 0.81664E+00, 0.81837E+00, + & 0.82009E+00, 0.82182E+00, 0.82354E+00, 0.82526E+00, 0.82697E+00, + & 0.82868E+00, 0.83039E+00, 0.83210E+00, 0.83381E+00, 0.83551E+00, + & 0.83721E+00, 0.83890E+00, 0.84060E+00, 0.84229E+00, 0.84398E+00, + & 0.84567E+00, 0.84735E+00, 0.84903E+00, 0.85071E+00, 0.85239E+00, + & 0.85406E+00, 0.85573E+00, 0.85740E+00, 0.85907E+00, 0.86074E+00, + & 0.86240E+00, 0.86406E+00, 0.86571E+00, 0.86737E+00, 0.86902E+00/ + + DATA (BNC09M (I),I=501,600)/ + & 0.87067E+00, 0.87232E+00, 0.87396E+00, 0.87560E+00, 0.87724E+00, + & 0.87888E+00, 0.88052E+00, 0.88215E+00, 0.88378E+00, 0.88541E+00, + & 0.88703E+00, 0.88865E+00, 0.89028E+00, 0.89189E+00, 0.89351E+00, + & 0.89512E+00, 0.89674E+00, 0.89834E+00, 0.89995E+00, 0.90156E+00, + & 0.90316E+00, 0.90476E+00, 0.90635E+00, 0.90795E+00, 0.90954E+00, + & 0.91113E+00, 0.91272E+00, 0.91431E+00, 0.91589E+00, 0.91747E+00, + & 0.91905E+00, 0.92063E+00, 0.92221E+00, 0.92378E+00, 0.92535E+00, + & 0.92692E+00, 0.92848E+00, 0.93005E+00, 0.93161E+00, 0.93317E+00, + & 0.93472E+00, 0.93628E+00, 0.93783E+00, 0.93938E+00, 0.94093E+00, + & 0.94248E+00, 0.94402E+00, 0.94556E+00, 0.94710E+00, 0.94864E+00, + & 0.95018E+00, 0.95171E+00, 0.95324E+00, 0.95477E+00, 0.95630E+00, + & 0.95782E+00, 0.95935E+00, 0.96087E+00, 0.96239E+00, 0.96390E+00, + & 0.96542E+00, 0.96693E+00, 0.96844E+00, 0.96995E+00, 0.97145E+00, + & 0.97296E+00, 0.97446E+00, 0.97596E+00, 0.97746E+00, 0.97896E+00, + & 0.98045E+00, 0.98194E+00, 0.98343E+00, 0.98492E+00, 0.98641E+00, + & 0.98789E+00, 0.98937E+00, 0.99085E+00, 0.99233E+00, 0.99380E+00, + & 0.99528E+00, 0.99675E+00, 0.99822E+00, 0.99969E+00, 0.10012E+01, + & 0.10026E+01, 0.10041E+01, 0.10055E+01, 0.10070E+01, 0.10085E+01, + & 0.10099E+01, 0.10114E+01, 0.10128E+01, 0.10143E+01, 0.10157E+01, + & 0.10172E+01, 0.10186E+01, 0.10200E+01, 0.10215E+01, 0.10269E+01/ + + DATA (BNC09M (I),I=601,700)/ + & 0.10386E+01, 0.10527E+01, 0.10666E+01, 0.10803E+01, 0.10938E+01, + & 0.11072E+01, 0.11204E+01, 0.11334E+01, 0.11463E+01, 0.11591E+01, + & 0.11717E+01, 0.11841E+01, 0.11964E+01, 0.12086E+01, 0.12206E+01, + & 0.12325E+01, 0.12442E+01, 0.12558E+01, 0.12673E+01, 0.12787E+01, + & 0.12900E+01, 0.13011E+01, 0.13121E+01, 0.13230E+01, 0.13338E+01, + & 0.13444E+01, 0.13550E+01, 0.13655E+01, 0.13758E+01, 0.13860E+01, + & 0.13962E+01, 0.14062E+01, 0.14162E+01, 0.14260E+01, 0.14358E+01, + & 0.14454E+01, 0.14550E+01, 0.14645E+01, 0.14738E+01, 0.14831E+01, + & 0.14923E+01, 0.15015E+01, 0.15105E+01, 0.15195E+01, 0.15284E+01, + & 0.15372E+01, 0.15459E+01, 0.15545E+01, 0.15631E+01, 0.15716E+01, + & 0.15800E+01, 0.15884E+01, 0.15966E+01, 0.16049E+01, 0.16130E+01, + & 0.16211E+01, 0.16291E+01, 0.16370E+01, 0.16449E+01, 0.16527E+01, + & 0.16604E+01, 0.16681E+01, 0.16757E+01, 0.16833E+01, 0.16908E+01, + & 0.16982E+01, 0.17056E+01, 0.17129E+01, 0.17201E+01, 0.17273E+01, + & 0.17345E+01, 0.17416E+01, 0.17486E+01, 0.17556E+01, 0.17625E+01, + & 0.17694E+01, 0.17763E+01, 0.17830E+01, 0.17898E+01, 0.17964E+01, + & 0.18031E+01, 0.18097E+01, 0.18162E+01, 0.18227E+01, 0.18291E+01, + & 0.18355E+01, 0.18418E+01, 0.18481E+01, 0.18544E+01, 0.18606E+01, + & 0.18668E+01, 0.18729E+01, 0.18790E+01, 0.18850E+01, 0.18910E+01, + & 0.18970E+01, 0.19029E+01, 0.19088E+01, 0.19146E+01, 0.19204E+01/ + + DATA (BNC09M(I),I=701,741)/ + & 0.19262E+01, 0.19319E+01, 0.19376E+01, 0.19432E+01, 0.19488E+01, + & 0.19544E+01, 0.19599E+01, 0.19654E+01, 0.19709E+01, 0.19763E+01, + & 0.19817E+01, 0.19871E+01, 0.19924E+01, 0.19977E+01, 0.20029E+01, + & 0.20082E+01, 0.20133E+01, 0.20185E+01, 0.20236E+01, 0.20287E+01, + & 0.20338E+01, 0.20388E+01, 0.20438E+01, 0.20488E+01, 0.20537E+01, + & 0.20586E+01, 0.20635E+01, 0.20683E+01, 0.20731E+01, 0.20779E+01, + & 0.20827E+01, 0.20874E+01, 0.20921E+01, 0.20968E+01, 0.21014E+01, + & 0.21061E+01, 0.21107E+01, 0.21152E+01, 0.21198E+01, 0.21243E+01, + & 0.21288E+01 + & / +C +C *** (H, NO3) +C + DATA (BNC10M (I),I= 1,100)/ + &-0.50967E-01,-0.89573E-01,-0.11434E+00,-0.12971E+00,-0.14053E+00, + &-0.14861E+00,-0.15484E+00,-0.15973E+00,-0.16360E+00,-0.16667E+00, + &-0.16910E+00,-0.17099E+00,-0.17243E+00,-0.17350E+00,-0.17424E+00, + &-0.17470E+00,-0.17491E+00,-0.17491E+00,-0.17471E+00,-0.17434E+00, + &-0.17382E+00,-0.17316E+00,-0.17238E+00,-0.17148E+00,-0.17049E+00, + &-0.16940E+00,-0.16823E+00,-0.16699E+00,-0.16567E+00,-0.16430E+00, + &-0.16287E+00,-0.16138E+00,-0.15985E+00,-0.15828E+00,-0.15667E+00, + &-0.15502E+00,-0.15334E+00,-0.15163E+00,-0.14989E+00,-0.14814E+00, + &-0.14635E+00,-0.14456E+00,-0.14274E+00,-0.14090E+00,-0.13906E+00, + &-0.13720E+00,-0.13533E+00,-0.13344E+00,-0.13155E+00,-0.12965E+00, + &-0.12775E+00,-0.12583E+00,-0.12392E+00,-0.12199E+00,-0.12006E+00, + &-0.11812E+00,-0.11618E+00,-0.11424E+00,-0.11229E+00,-0.11033E+00, + &-0.10837E+00,-0.10640E+00,-0.10443E+00,-0.10246E+00,-0.10047E+00, + &-0.98485E-01,-0.96489E-01,-0.94485E-01,-0.92474E-01,-0.90455E-01, + &-0.88427E-01,-0.86389E-01,-0.84342E-01,-0.82285E-01,-0.80216E-01, + &-0.78136E-01,-0.76044E-01,-0.73940E-01,-0.71822E-01,-0.69692E-01, + &-0.67547E-01,-0.65389E-01,-0.63216E-01,-0.61028E-01,-0.58825E-01, + &-0.56607E-01,-0.54374E-01,-0.52125E-01,-0.49861E-01,-0.47581E-01, + &-0.45285E-01,-0.42974E-01,-0.40648E-01,-0.38307E-01,-0.35950E-01, + &-0.33579E-01,-0.31194E-01,-0.28794E-01,-0.26380E-01,-0.23953E-01/ + + DATA (BNC10M (I),I=101,200)/ + &-0.21514E-01,-0.19061E-01,-0.16597E-01,-0.14121E-01,-0.11634E-01, + &-0.91364E-02,-0.66288E-02,-0.41117E-02,-0.15855E-02, 0.94906E-03, + & 0.34915E-02, 0.60415E-02, 0.85982E-02, 0.11161E-01, 0.13730E-01, + & 0.16305E-01, 0.18884E-01, 0.21468E-01, 0.24056E-01, 0.26647E-01, + & 0.28953E-01, 0.31584E-01, 0.34213E-01, 0.36841E-01, 0.39469E-01, + & 0.42094E-01, 0.44719E-01, 0.47342E-01, 0.49964E-01, 0.52584E-01, + & 0.55203E-01, 0.57820E-01, 0.60435E-01, 0.63049E-01, 0.65661E-01, + & 0.68270E-01, 0.70878E-01, 0.73484E-01, 0.76088E-01, 0.78689E-01, + & 0.81289E-01, 0.83886E-01, 0.86481E-01, 0.89073E-01, 0.91664E-01, + & 0.94252E-01, 0.96837E-01, 0.99420E-01, 0.10200E+00, 0.10458E+00, + & 0.10715E+00, 0.10973E+00, 0.11230E+00, 0.11486E+00, 0.11743E+00, + & 0.11999E+00, 0.12255E+00, 0.12510E+00, 0.12766E+00, 0.13021E+00, + & 0.13276E+00, 0.13530E+00, 0.13784E+00, 0.14038E+00, 0.14291E+00, + & 0.14545E+00, 0.14798E+00, 0.15050E+00, 0.15303E+00, 0.15555E+00, + & 0.15806E+00, 0.16058E+00, 0.16309E+00, 0.16559E+00, 0.16810E+00, + & 0.17060E+00, 0.17309E+00, 0.17559E+00, 0.17808E+00, 0.18057E+00, + & 0.18305E+00, 0.18553E+00, 0.18801E+00, 0.19048E+00, 0.19295E+00, + & 0.19542E+00, 0.19788E+00, 0.20034E+00, 0.20280E+00, 0.20525E+00, + & 0.20770E+00, 0.21015E+00, 0.21259E+00, 0.21503E+00, 0.21747E+00, + & 0.21990E+00, 0.22233E+00, 0.22475E+00, 0.22718E+00, 0.22959E+00/ + + DATA (BNC10M (I),I=201,300)/ + & 0.23201E+00, 0.23442E+00, 0.23683E+00, 0.23923E+00, 0.24163E+00, + & 0.24403E+00, 0.24642E+00, 0.24881E+00, 0.25120E+00, 0.25358E+00, + & 0.25596E+00, 0.25833E+00, 0.26070E+00, 0.26307E+00, 0.26544E+00, + & 0.26780E+00, 0.27016E+00, 0.27251E+00, 0.27486E+00, 0.27721E+00, + & 0.27955E+00, 0.28189E+00, 0.28422E+00, 0.28655E+00, 0.28888E+00, + & 0.29121E+00, 0.29353E+00, 0.29585E+00, 0.29816E+00, 0.30047E+00, + & 0.30278E+00, 0.30508E+00, 0.30738E+00, 0.30967E+00, 0.31197E+00, + & 0.31425E+00, 0.31654E+00, 0.31882E+00, 0.32110E+00, 0.32337E+00, + & 0.32564E+00, 0.32791E+00, 0.33017E+00, 0.33243E+00, 0.33469E+00, + & 0.33694E+00, 0.33919E+00, 0.34143E+00, 0.34367E+00, 0.34591E+00, + & 0.34815E+00, 0.35038E+00, 0.35260E+00, 0.35483E+00, 0.35705E+00, + & 0.35926E+00, 0.36148E+00, 0.36369E+00, 0.36589E+00, 0.36809E+00, + & 0.37029E+00, 0.37249E+00, 0.37468E+00, 0.37687E+00, 0.37905E+00, + & 0.38123E+00, 0.38341E+00, 0.38558E+00, 0.38775E+00, 0.38992E+00, + & 0.39208E+00, 0.39424E+00, 0.39640E+00, 0.39855E+00, 0.40070E+00, + & 0.40285E+00, 0.40499E+00, 0.40713E+00, 0.40927E+00, 0.41140E+00, + & 0.41353E+00, 0.41565E+00, 0.41777E+00, 0.41989E+00, 0.42201E+00, + & 0.42412E+00, 0.42623E+00, 0.42833E+00, 0.43043E+00, 0.43253E+00, + & 0.43463E+00, 0.43672E+00, 0.43880E+00, 0.44089E+00, 0.44297E+00, + & 0.44505E+00, 0.44712E+00, 0.44919E+00, 0.45126E+00, 0.45332E+00/ + + DATA (BNC10M (I),I=301,400)/ + & 0.45539E+00, 0.45744E+00, 0.45950E+00, 0.46155E+00, 0.46360E+00, + & 0.46564E+00, 0.46768E+00, 0.46972E+00, 0.47175E+00, 0.47378E+00, + & 0.47581E+00, 0.47784E+00, 0.47986E+00, 0.48188E+00, 0.48389E+00, + & 0.48590E+00, 0.48791E+00, 0.48992E+00, 0.49192E+00, 0.49392E+00, + & 0.49591E+00, 0.49790E+00, 0.49989E+00, 0.50188E+00, 0.50386E+00, + & 0.50584E+00, 0.50782E+00, 0.50979E+00, 0.51176E+00, 0.51373E+00, + & 0.51569E+00, 0.51765E+00, 0.51961E+00, 0.52156E+00, 0.52352E+00, + & 0.52546E+00, 0.52741E+00, 0.52935E+00, 0.53129E+00, 0.53323E+00, + & 0.53516E+00, 0.53709E+00, 0.53901E+00, 0.54094E+00, 0.54286E+00, + & 0.54478E+00, 0.54669E+00, 0.54860E+00, 0.55051E+00, 0.55241E+00, + & 0.55432E+00, 0.55622E+00, 0.55811E+00, 0.56001E+00, 0.56190E+00, + & 0.56378E+00, 0.56567E+00, 0.56755E+00, 0.56943E+00, 0.57130E+00, + & 0.57318E+00, 0.57505E+00, 0.57691E+00, 0.57878E+00, 0.58064E+00, + & 0.58249E+00, 0.58435E+00, 0.58620E+00, 0.58805E+00, 0.58990E+00, + & 0.59174E+00, 0.59358E+00, 0.59542E+00, 0.59725E+00, 0.59909E+00, + & 0.60092E+00, 0.60274E+00, 0.60457E+00, 0.60639E+00, 0.60820E+00, + & 0.61002E+00, 0.61183E+00, 0.61364E+00, 0.61545E+00, 0.61725E+00, + & 0.61905E+00, 0.62085E+00, 0.62265E+00, 0.62444E+00, 0.62623E+00, + & 0.62802E+00, 0.62980E+00, 0.63158E+00, 0.63336E+00, 0.63514E+00, + & 0.63691E+00, 0.63868E+00, 0.64045E+00, 0.64222E+00, 0.64398E+00/ + + DATA (BNC10M (I),I=401,500)/ + & 0.64574E+00, 0.64750E+00, 0.64925E+00, 0.65100E+00, 0.65275E+00, + & 0.65450E+00, 0.65624E+00, 0.65798E+00, 0.65972E+00, 0.66146E+00, + & 0.66319E+00, 0.66492E+00, 0.66665E+00, 0.66838E+00, 0.67010E+00, + & 0.67182E+00, 0.67354E+00, 0.67526E+00, 0.67697E+00, 0.67868E+00, + & 0.68039E+00, 0.68209E+00, 0.68379E+00, 0.68549E+00, 0.68719E+00, + & 0.68889E+00, 0.69058E+00, 0.69227E+00, 0.69396E+00, 0.69564E+00, + & 0.69732E+00, 0.69900E+00, 0.70068E+00, 0.70236E+00, 0.70403E+00, + & 0.70570E+00, 0.70736E+00, 0.70903E+00, 0.71069E+00, 0.71235E+00, + & 0.71401E+00, 0.71567E+00, 0.71732E+00, 0.71897E+00, 0.72062E+00, + & 0.72226E+00, 0.72390E+00, 0.72555E+00, 0.72718E+00, 0.72882E+00, + & 0.73045E+00, 0.73208E+00, 0.73371E+00, 0.73534E+00, 0.73696E+00, + & 0.73858E+00, 0.74020E+00, 0.74182E+00, 0.74344E+00, 0.74505E+00, + & 0.74666E+00, 0.74826E+00, 0.74987E+00, 0.75147E+00, 0.75307E+00, + & 0.75467E+00, 0.75627E+00, 0.75786E+00, 0.75945E+00, 0.76104E+00, + & 0.76263E+00, 0.76421E+00, 0.76580E+00, 0.76738E+00, 0.76895E+00, + & 0.77053E+00, 0.77210E+00, 0.77367E+00, 0.77524E+00, 0.77681E+00, + & 0.77837E+00, 0.77993E+00, 0.78149E+00, 0.78305E+00, 0.78461E+00, + & 0.78616E+00, 0.78771E+00, 0.78926E+00, 0.79081E+00, 0.79235E+00, + & 0.79389E+00, 0.79543E+00, 0.79697E+00, 0.79851E+00, 0.80004E+00, + & 0.80157E+00, 0.80310E+00, 0.80463E+00, 0.80615E+00, 0.80768E+00/ + + DATA (BNC10M (I),I=501,600)/ + & 0.80920E+00, 0.81072E+00, 0.81223E+00, 0.81375E+00, 0.81526E+00, + & 0.81677E+00, 0.81828E+00, 0.81978E+00, 0.82129E+00, 0.82279E+00, + & 0.82429E+00, 0.82579E+00, 0.82728E+00, 0.82878E+00, 0.83027E+00, + & 0.83176E+00, 0.83324E+00, 0.83473E+00, 0.83621E+00, 0.83769E+00, + & 0.83917E+00, 0.84065E+00, 0.84213E+00, 0.84360E+00, 0.84507E+00, + & 0.84654E+00, 0.84801E+00, 0.84947E+00, 0.85093E+00, 0.85240E+00, + & 0.85385E+00, 0.85531E+00, 0.85677E+00, 0.85822E+00, 0.85967E+00, + & 0.86112E+00, 0.86257E+00, 0.86401E+00, 0.86546E+00, 0.86690E+00, + & 0.86834E+00, 0.86977E+00, 0.87121E+00, 0.87264E+00, 0.87408E+00, + & 0.87551E+00, 0.87693E+00, 0.87836E+00, 0.87978E+00, 0.88121E+00, + & 0.88263E+00, 0.88404E+00, 0.88546E+00, 0.88688E+00, 0.88829E+00, + & 0.88970E+00, 0.89111E+00, 0.89251E+00, 0.89392E+00, 0.89532E+00, + & 0.89672E+00, 0.89812E+00, 0.89952E+00, 0.90092E+00, 0.90231E+00, + & 0.90370E+00, 0.90510E+00, 0.90648E+00, 0.90787E+00, 0.90926E+00, + & 0.91064E+00, 0.91202E+00, 0.91340E+00, 0.91478E+00, 0.91615E+00, + & 0.91753E+00, 0.91890E+00, 0.92027E+00, 0.92164E+00, 0.92301E+00, + & 0.92437E+00, 0.92573E+00, 0.92710E+00, 0.92846E+00, 0.92981E+00, + & 0.93117E+00, 0.93252E+00, 0.93388E+00, 0.93523E+00, 0.93658E+00, + & 0.93793E+00, 0.93927E+00, 0.94062E+00, 0.94196E+00, 0.94330E+00, + & 0.94464E+00, 0.94598E+00, 0.94731E+00, 0.94864E+00, 0.95363E+00/ + + DATA (BNC10M (I),I=601,700)/ + & 0.96452E+00, 0.97756E+00, 0.99045E+00, 0.10032E+01, 0.10157E+01, + & 0.10282E+01, 0.10404E+01, 0.10525E+01, 0.10645E+01, 0.10763E+01, + & 0.10880E+01, 0.10996E+01, 0.11110E+01, 0.11223E+01, 0.11335E+01, + & 0.11445E+01, 0.11555E+01, 0.11663E+01, 0.11769E+01, 0.11875E+01, + & 0.11980E+01, 0.12083E+01, 0.12185E+01, 0.12287E+01, 0.12387E+01, + & 0.12486E+01, 0.12584E+01, 0.12681E+01, 0.12777E+01, 0.12872E+01, + & 0.12967E+01, 0.13060E+01, 0.13152E+01, 0.13244E+01, 0.13334E+01, + & 0.13424E+01, 0.13513E+01, 0.13601E+01, 0.13688E+01, 0.13774E+01, + & 0.13860E+01, 0.13944E+01, 0.14028E+01, 0.14111E+01, 0.14194E+01, + & 0.14275E+01, 0.14356E+01, 0.14437E+01, 0.14516E+01, 0.14595E+01, + & 0.14673E+01, 0.14750E+01, 0.14827E+01, 0.14903E+01, 0.14978E+01, + & 0.15053E+01, 0.15127E+01, 0.15201E+01, 0.15274E+01, 0.15346E+01, + & 0.15418E+01, 0.15489E+01, 0.15559E+01, 0.15629E+01, 0.15698E+01, + & 0.15767E+01, 0.15835E+01, 0.15903E+01, 0.15970E+01, 0.16037E+01, + & 0.16103E+01, 0.16168E+01, 0.16233E+01, 0.16298E+01, 0.16362E+01, + & 0.16425E+01, 0.16488E+01, 0.16551E+01, 0.16613E+01, 0.16675E+01, + & 0.16736E+01, 0.16797E+01, 0.16857E+01, 0.16917E+01, 0.16976E+01, + & 0.17035E+01, 0.17093E+01, 0.17152E+01, 0.17209E+01, 0.17266E+01, + & 0.17323E+01, 0.17380E+01, 0.17436E+01, 0.17491E+01, 0.17546E+01, + & 0.17601E+01, 0.17656E+01, 0.17710E+01, 0.17763E+01, 0.17817E+01/ + + DATA (BNC10M(I),I=701,741)/ + & 0.17870E+01, 0.17922E+01, 0.17975E+01, 0.18026E+01, 0.18078E+01, + & 0.18129E+01, 0.18180E+01, 0.18230E+01, 0.18281E+01, 0.18330E+01, + & 0.18380E+01, 0.18429E+01, 0.18478E+01, 0.18526E+01, 0.18575E+01, + & 0.18622E+01, 0.18670E+01, 0.18717E+01, 0.18764E+01, 0.18811E+01, + & 0.18857E+01, 0.18903E+01, 0.18949E+01, 0.18994E+01, 0.19040E+01, + & 0.19085E+01, 0.19129E+01, 0.19174E+01, 0.19218E+01, 0.19261E+01, + & 0.19305E+01, 0.19348E+01, 0.19391E+01, 0.19434E+01, 0.19476E+01, + & 0.19519E+01, 0.19560E+01, 0.19602E+01, 0.19644E+01, 0.19685E+01, + & 0.19726E+01 + & / +C +C *** (H, Cl) +C + DATA (BNC11M (I),I= 1,100)/ + &-0.49531E-01,-0.84652E-01,-0.10547E+00,-0.11724E+00,-0.12469E+00, + &-0.12951E+00,-0.13255E+00,-0.13431E+00,-0.13506E+00,-0.13503E+00, + &-0.13435E+00,-0.13313E+00,-0.13145E+00,-0.12937E+00,-0.12694E+00, + &-0.12420E+00,-0.12119E+00,-0.11793E+00,-0.11444E+00,-0.11075E+00, + &-0.10687E+00,-0.10282E+00,-0.98618E-01,-0.94265E-01,-0.89778E-01, + &-0.85165E-01,-0.80436E-01,-0.75599E-01,-0.70661E-01,-0.65628E-01, + &-0.60508E-01,-0.55306E-01,-0.50028E-01,-0.44679E-01,-0.39262E-01, + &-0.33784E-01,-0.28247E-01,-0.22657E-01,-0.17017E-01,-0.11329E-01, + &-0.55978E-02, 0.17400E-03, 0.59837E-02, 0.11828E-01, 0.17706E-01, + & 0.23614E-01, 0.29550E-01, 0.35513E-01, 0.41500E-01, 0.47510E-01, + & 0.53542E-01, 0.59594E-01, 0.65665E-01, 0.71754E-01, 0.77861E-01, + & 0.83984E-01, 0.90123E-01, 0.96278E-01, 0.10245E+00, 0.10863E+00, + & 0.11483E+00, 0.12105E+00, 0.12728E+00, 0.13353E+00, 0.13979E+00, + & 0.14608E+00, 0.15237E+00, 0.15869E+00, 0.16503E+00, 0.17138E+00, + & 0.17776E+00, 0.18415E+00, 0.19058E+00, 0.19702E+00, 0.20349E+00, + & 0.20998E+00, 0.21650E+00, 0.22305E+00, 0.22962E+00, 0.23623E+00, + & 0.24286E+00, 0.24953E+00, 0.25623E+00, 0.26295E+00, 0.26972E+00, + & 0.27651E+00, 0.28334E+00, 0.29020E+00, 0.29709E+00, 0.30402E+00, + & 0.31098E+00, 0.31798E+00, 0.32500E+00, 0.33206E+00, 0.33916E+00, + & 0.34628E+00, 0.35343E+00, 0.36062E+00, 0.36783E+00, 0.37507E+00/ + + DATA (BNC11M (I),I=101,200)/ + & 0.38234E+00, 0.38964E+00, 0.39696E+00, 0.40431E+00, 0.41167E+00, + & 0.41906E+00, 0.42647E+00, 0.43390E+00, 0.44134E+00, 0.44880E+00, + & 0.45628E+00, 0.46377E+00, 0.47127E+00, 0.47879E+00, 0.48631E+00, + & 0.49384E+00, 0.50138E+00, 0.50893E+00, 0.51648E+00, 0.52403E+00, + & 0.53093E+00, 0.53856E+00, 0.54619E+00, 0.55382E+00, 0.56143E+00, + & 0.56904E+00, 0.57664E+00, 0.58424E+00, 0.59182E+00, 0.59940E+00, + & 0.60697E+00, 0.61453E+00, 0.62208E+00, 0.62962E+00, 0.63715E+00, + & 0.64467E+00, 0.65218E+00, 0.65969E+00, 0.66718E+00, 0.67466E+00, + & 0.68213E+00, 0.68959E+00, 0.69704E+00, 0.70448E+00, 0.71191E+00, + & 0.71933E+00, 0.72674E+00, 0.73413E+00, 0.74152E+00, 0.74889E+00, + & 0.75625E+00, 0.76360E+00, 0.77094E+00, 0.77826E+00, 0.78557E+00, + & 0.79288E+00, 0.80016E+00, 0.80744E+00, 0.81471E+00, 0.82196E+00, + & 0.82920E+00, 0.83642E+00, 0.84364E+00, 0.85084E+00, 0.85803E+00, + & 0.86520E+00, 0.87237E+00, 0.87952E+00, 0.88665E+00, 0.89378E+00, + & 0.90089E+00, 0.90799E+00, 0.91507E+00, 0.92215E+00, 0.92921E+00, + & 0.93625E+00, 0.94328E+00, 0.95030E+00, 0.95731E+00, 0.96430E+00, + & 0.97128E+00, 0.97825E+00, 0.98520E+00, 0.99214E+00, 0.99907E+00, + & 0.10060E+01, 0.10129E+01, 0.10198E+01, 0.10266E+01, 0.10335E+01, + & 0.10403E+01, 0.10472E+01, 0.10540E+01, 0.10608E+01, 0.10676E+01, + & 0.10744E+01, 0.10811E+01, 0.10879E+01, 0.10946E+01, 0.11014E+01/ + + DATA (BNC11M (I),I=201,300)/ + & 0.11081E+01, 0.11148E+01, 0.11214E+01, 0.11281E+01, 0.11348E+01, + & 0.11414E+01, 0.11481E+01, 0.11547E+01, 0.11613E+01, 0.11679E+01, + & 0.11745E+01, 0.11810E+01, 0.11876E+01, 0.11941E+01, 0.12006E+01, + & 0.12071E+01, 0.12136E+01, 0.12201E+01, 0.12266E+01, 0.12331E+01, + & 0.12395E+01, 0.12460E+01, 0.12524E+01, 0.12588E+01, 0.12652E+01, + & 0.12716E+01, 0.12779E+01, 0.12843E+01, 0.12906E+01, 0.12970E+01, + & 0.13033E+01, 0.13096E+01, 0.13159E+01, 0.13222E+01, 0.13284E+01, + & 0.13347E+01, 0.13409E+01, 0.13472E+01, 0.13534E+01, 0.13596E+01, + & 0.13658E+01, 0.13720E+01, 0.13781E+01, 0.13843E+01, 0.13904E+01, + & 0.13966E+01, 0.14027E+01, 0.14088E+01, 0.14149E+01, 0.14210E+01, + & 0.14270E+01, 0.14331E+01, 0.14391E+01, 0.14452E+01, 0.14512E+01, + & 0.14572E+01, 0.14632E+01, 0.14692E+01, 0.14751E+01, 0.14811E+01, + & 0.14871E+01, 0.14930E+01, 0.14989E+01, 0.15048E+01, 0.15107E+01, + & 0.15166E+01, 0.15225E+01, 0.15284E+01, 0.15342E+01, 0.15401E+01, + & 0.15459E+01, 0.15517E+01, 0.15575E+01, 0.15633E+01, 0.15691E+01, + & 0.15749E+01, 0.15807E+01, 0.15864E+01, 0.15922E+01, 0.15979E+01, + & 0.16036E+01, 0.16093E+01, 0.16150E+01, 0.16207E+01, 0.16264E+01, + & 0.16320E+01, 0.16377E+01, 0.16433E+01, 0.16490E+01, 0.16546E+01, + & 0.16602E+01, 0.16658E+01, 0.16714E+01, 0.16770E+01, 0.16825E+01, + & 0.16881E+01, 0.16936E+01, 0.16992E+01, 0.17047E+01, 0.17102E+01/ + + DATA (BNC11M (I),I=301,400)/ + & 0.17157E+01, 0.17212E+01, 0.17267E+01, 0.17321E+01, 0.17376E+01, + & 0.17431E+01, 0.17485E+01, 0.17539E+01, 0.17593E+01, 0.17648E+01, + & 0.17702E+01, 0.17755E+01, 0.17809E+01, 0.17863E+01, 0.17917E+01, + & 0.17970E+01, 0.18023E+01, 0.18077E+01, 0.18130E+01, 0.18183E+01, + & 0.18236E+01, 0.18289E+01, 0.18342E+01, 0.18394E+01, 0.18447E+01, + & 0.18500E+01, 0.18552E+01, 0.18604E+01, 0.18656E+01, 0.18709E+01, + & 0.18761E+01, 0.18813E+01, 0.18864E+01, 0.18916E+01, 0.18968E+01, + & 0.19019E+01, 0.19071E+01, 0.19122E+01, 0.19173E+01, 0.19225E+01, + & 0.19276E+01, 0.19327E+01, 0.19378E+01, 0.19428E+01, 0.19479E+01, + & 0.19530E+01, 0.19580E+01, 0.19631E+01, 0.19681E+01, 0.19731E+01, + & 0.19782E+01, 0.19832E+01, 0.19882E+01, 0.19932E+01, 0.19981E+01, + & 0.20031E+01, 0.20081E+01, 0.20130E+01, 0.20180E+01, 0.20229E+01, + & 0.20278E+01, 0.20328E+01, 0.20377E+01, 0.20426E+01, 0.20475E+01, + & 0.20524E+01, 0.20572E+01, 0.20621E+01, 0.20670E+01, 0.20718E+01, + & 0.20767E+01, 0.20815E+01, 0.20863E+01, 0.20912E+01, 0.20960E+01, + & 0.21008E+01, 0.21056E+01, 0.21104E+01, 0.21151E+01, 0.21199E+01, + & 0.21247E+01, 0.21294E+01, 0.21342E+01, 0.21389E+01, 0.21436E+01, + & 0.21483E+01, 0.21531E+01, 0.21578E+01, 0.21625E+01, 0.21672E+01, + & 0.21718E+01, 0.21765E+01, 0.21812E+01, 0.21858E+01, 0.21905E+01, + & 0.21951E+01, 0.21998E+01, 0.22044E+01, 0.22090E+01, 0.22136E+01/ + + DATA (BNC11M (I),I=401,500)/ + & 0.22182E+01, 0.22228E+01, 0.22274E+01, 0.22320E+01, 0.22366E+01, + & 0.22411E+01, 0.22457E+01, 0.22502E+01, 0.22548E+01, 0.22593E+01, + & 0.22638E+01, 0.22684E+01, 0.22729E+01, 0.22774E+01, 0.22819E+01, + & 0.22864E+01, 0.22908E+01, 0.22953E+01, 0.22998E+01, 0.23043E+01, + & 0.23087E+01, 0.23132E+01, 0.23176E+01, 0.23220E+01, 0.23265E+01, + & 0.23309E+01, 0.23353E+01, 0.23397E+01, 0.23441E+01, 0.23485E+01, + & 0.23529E+01, 0.23572E+01, 0.23616E+01, 0.23660E+01, 0.23703E+01, + & 0.23747E+01, 0.23790E+01, 0.23834E+01, 0.23877E+01, 0.23920E+01, + & 0.23963E+01, 0.24006E+01, 0.24049E+01, 0.24092E+01, 0.24135E+01, + & 0.24178E+01, 0.24221E+01, 0.24263E+01, 0.24306E+01, 0.24349E+01, + & 0.24391E+01, 0.24434E+01, 0.24476E+01, 0.24518E+01, 0.24560E+01, + & 0.24603E+01, 0.24645E+01, 0.24687E+01, 0.24729E+01, 0.24770E+01, + & 0.24812E+01, 0.24854E+01, 0.24896E+01, 0.24937E+01, 0.24979E+01, + & 0.25021E+01, 0.25062E+01, 0.25103E+01, 0.25145E+01, 0.25186E+01, + & 0.25227E+01, 0.25268E+01, 0.25309E+01, 0.25350E+01, 0.25391E+01, + & 0.25432E+01, 0.25473E+01, 0.25514E+01, 0.25554E+01, 0.25595E+01, + & 0.25636E+01, 0.25676E+01, 0.25717E+01, 0.25757E+01, 0.25797E+01, + & 0.25838E+01, 0.25878E+01, 0.25918E+01, 0.25958E+01, 0.25998E+01, + & 0.26038E+01, 0.26078E+01, 0.26118E+01, 0.26158E+01, 0.26198E+01, + & 0.26237E+01, 0.26277E+01, 0.26317E+01, 0.26356E+01, 0.26396E+01/ + + DATA (BNC11M (I),I=501,600)/ + & 0.26435E+01, 0.26474E+01, 0.26514E+01, 0.26553E+01, 0.26592E+01, + & 0.26631E+01, 0.26670E+01, 0.26709E+01, 0.26748E+01, 0.26787E+01, + & 0.26826E+01, 0.26865E+01, 0.26903E+01, 0.26942E+01, 0.26981E+01, + & 0.27019E+01, 0.27058E+01, 0.27096E+01, 0.27135E+01, 0.27173E+01, + & 0.27211E+01, 0.27249E+01, 0.27288E+01, 0.27326E+01, 0.27364E+01, + & 0.27402E+01, 0.27440E+01, 0.27478E+01, 0.27516E+01, 0.27553E+01, + & 0.27591E+01, 0.27629E+01, 0.27667E+01, 0.27704E+01, 0.27742E+01, + & 0.27779E+01, 0.27817E+01, 0.27854E+01, 0.27891E+01, 0.27929E+01, + & 0.27966E+01, 0.28003E+01, 0.28040E+01, 0.28077E+01, 0.28114E+01, + & 0.28151E+01, 0.28188E+01, 0.28225E+01, 0.28262E+01, 0.28299E+01, + & 0.28335E+01, 0.28372E+01, 0.28409E+01, 0.28445E+01, 0.28482E+01, + & 0.28518E+01, 0.28555E+01, 0.28591E+01, 0.28627E+01, 0.28664E+01, + & 0.28700E+01, 0.28736E+01, 0.28772E+01, 0.28808E+01, 0.28844E+01, + & 0.28880E+01, 0.28916E+01, 0.28952E+01, 0.28988E+01, 0.29024E+01, + & 0.29060E+01, 0.29095E+01, 0.29131E+01, 0.29167E+01, 0.29202E+01, + & 0.29238E+01, 0.29273E+01, 0.29309E+01, 0.29344E+01, 0.29379E+01, + & 0.29415E+01, 0.29450E+01, 0.29485E+01, 0.29520E+01, 0.29555E+01, + & 0.29590E+01, 0.29625E+01, 0.29660E+01, 0.29695E+01, 0.29730E+01, + & 0.29765E+01, 0.29800E+01, 0.29834E+01, 0.29869E+01, 0.29904E+01, + & 0.29938E+01, 0.29973E+01, 0.30007E+01, 0.30042E+01, 0.30171E+01/ + + DATA (BNC11M (I),I=601,700)/ + & 0.30452E+01, 0.30789E+01, 0.31122E+01, 0.31450E+01, 0.31775E+01, + & 0.32096E+01, 0.32413E+01, 0.32726E+01, 0.33035E+01, 0.33341E+01, + & 0.33644E+01, 0.33943E+01, 0.34238E+01, 0.34531E+01, 0.34820E+01, + & 0.35106E+01, 0.35389E+01, 0.35668E+01, 0.35945E+01, 0.36219E+01, + & 0.36490E+01, 0.36759E+01, 0.37024E+01, 0.37287E+01, 0.37548E+01, + & 0.37805E+01, 0.38061E+01, 0.38313E+01, 0.38564E+01, 0.38811E+01, + & 0.39057E+01, 0.39300E+01, 0.39541E+01, 0.39780E+01, 0.40016E+01, + & 0.40250E+01, 0.40483E+01, 0.40713E+01, 0.40941E+01, 0.41167E+01, + & 0.41391E+01, 0.41613E+01, 0.41833E+01, 0.42051E+01, 0.42268E+01, + & 0.42482E+01, 0.42695E+01, 0.42906E+01, 0.43116E+01, 0.43323E+01, + & 0.43529E+01, 0.43733E+01, 0.43936E+01, 0.44137E+01, 0.44336E+01, + & 0.44534E+01, 0.44730E+01, 0.44925E+01, 0.45118E+01, 0.45310E+01, + & 0.45500E+01, 0.45689E+01, 0.45877E+01, 0.46063E+01, 0.46247E+01, + & 0.46431E+01, 0.46613E+01, 0.46793E+01, 0.46973E+01, 0.47151E+01, + & 0.47327E+01, 0.47503E+01, 0.47677E+01, 0.47850E+01, 0.48022E+01, + & 0.48193E+01, 0.48362E+01, 0.48530E+01, 0.48698E+01, 0.48864E+01, + & 0.49029E+01, 0.49192E+01, 0.49355E+01, 0.49517E+01, 0.49677E+01, + & 0.49837E+01, 0.49995E+01, 0.50153E+01, 0.50309E+01, 0.50465E+01, + & 0.50619E+01, 0.50773E+01, 0.50925E+01, 0.51077E+01, 0.51227E+01, + & 0.51377E+01, 0.51526E+01, 0.51673E+01, 0.51820E+01, 0.51966E+01/ + + DATA (BNC11M(I),I=701,741)/ + & 0.52112E+01, 0.52256E+01, 0.52399E+01, 0.52542E+01, 0.52683E+01, + & 0.52824E+01, 0.52964E+01, 0.53104E+01, 0.53242E+01, 0.53380E+01, + & 0.53516E+01, 0.53652E+01, 0.53788E+01, 0.53922E+01, 0.54056E+01, + & 0.54189E+01, 0.54321E+01, 0.54453E+01, 0.54583E+01, 0.54713E+01, + & 0.54843E+01, 0.54971E+01, 0.55099E+01, 0.55226E+01, 0.55353E+01, + & 0.55479E+01, 0.55604E+01, 0.55729E+01, 0.55852E+01, 0.55976E+01, + & 0.56098E+01, 0.56220E+01, 0.56341E+01, 0.56462E+01, 0.56582E+01, + & 0.56701E+01, 0.56820E+01, 0.56938E+01, 0.57056E+01, 0.57173E+01, + & 0.57289E+01 + & / +C +C *** NaHSO4 +C + DATA (BNC12M (I),I= 1,100)/ + &-0.50782E-01,-0.89259E-01,-0.11419E+00,-0.12989E+00,-0.14113E+00, + &-0.14967E+00,-0.15637E+00,-0.16174E+00,-0.16609E+00,-0.16962E+00, + &-0.17248E+00,-0.17478E+00,-0.17660E+00,-0.17801E+00,-0.17906E+00, + &-0.17979E+00,-0.18023E+00,-0.18040E+00,-0.18034E+00,-0.18006E+00, + &-0.17958E+00,-0.17891E+00,-0.17806E+00,-0.17706E+00,-0.17590E+00, + &-0.17460E+00,-0.17317E+00,-0.17160E+00,-0.16992E+00,-0.16812E+00, + &-0.16621E+00,-0.16420E+00,-0.16208E+00,-0.15987E+00,-0.15758E+00, + &-0.15519E+00,-0.15272E+00,-0.15017E+00,-0.14755E+00,-0.14485E+00, + &-0.14209E+00,-0.13925E+00,-0.13636E+00,-0.13340E+00,-0.13038E+00, + &-0.12731E+00,-0.12418E+00,-0.12100E+00,-0.11777E+00,-0.11449E+00, + &-0.11116E+00,-0.10779E+00,-0.10438E+00,-0.10093E+00,-0.97430E-01, + &-0.93896E-01,-0.90324E-01,-0.86716E-01,-0.83072E-01,-0.79393E-01, + &-0.75680E-01,-0.71935E-01,-0.68156E-01,-0.64346E-01,-0.60504E-01, + &-0.56631E-01,-0.52728E-01,-0.48793E-01,-0.44829E-01,-0.40834E-01, + &-0.36810E-01,-0.32755E-01,-0.28670E-01,-0.24555E-01,-0.20411E-01, + &-0.16235E-01,-0.12030E-01,-0.77941E-02,-0.35277E-02, 0.76915E-03, + & 0.50967E-02, 0.94548E-02, 0.13844E-01, 0.18263E-01, 0.22713E-01, + & 0.27194E-01, 0.31705E-01, 0.36246E-01, 0.40817E-01, 0.45417E-01, + & 0.50047E-01, 0.54705E-01, 0.59392E-01, 0.64106E-01, 0.68847E-01, + & 0.73615E-01, 0.78408E-01, 0.83227E-01, 0.88069E-01, 0.92934E-01/ + + DATA (BNC12M (I),I=101,200)/ + & 0.97821E-01, 0.10273E+00, 0.10766E+00, 0.11261E+00, 0.11757E+00, + & 0.12256E+00, 0.12756E+00, 0.13257E+00, 0.13760E+00, 0.14264E+00, + & 0.14770E+00, 0.15276E+00, 0.15784E+00, 0.16292E+00, 0.16801E+00, + & 0.17311E+00, 0.17821E+00, 0.18332E+00, 0.18843E+00, 0.19355E+00, + & 0.19820E+00, 0.20337E+00, 0.20854E+00, 0.21370E+00, 0.21886E+00, + & 0.22401E+00, 0.22916E+00, 0.23430E+00, 0.23944E+00, 0.24457E+00, + & 0.24969E+00, 0.25481E+00, 0.25992E+00, 0.26502E+00, 0.27012E+00, + & 0.27521E+00, 0.28029E+00, 0.28536E+00, 0.29043E+00, 0.29548E+00, + & 0.30053E+00, 0.30558E+00, 0.31061E+00, 0.31563E+00, 0.32065E+00, + & 0.32566E+00, 0.33066E+00, 0.33565E+00, 0.34063E+00, 0.34560E+00, + & 0.35057E+00, 0.35552E+00, 0.36047E+00, 0.36541E+00, 0.37033E+00, + & 0.37525E+00, 0.38016E+00, 0.38506E+00, 0.38995E+00, 0.39483E+00, + & 0.39971E+00, 0.40457E+00, 0.40942E+00, 0.41426E+00, 0.41910E+00, + & 0.42392E+00, 0.42873E+00, 0.43354E+00, 0.43833E+00, 0.44312E+00, + & 0.44789E+00, 0.45266E+00, 0.45742E+00, 0.46216E+00, 0.46690E+00, + & 0.47163E+00, 0.47634E+00, 0.48105E+00, 0.48575E+00, 0.49043E+00, + & 0.49511E+00, 0.49978E+00, 0.50444E+00, 0.50909E+00, 0.51373E+00, + & 0.51836E+00, 0.52298E+00, 0.52759E+00, 0.53219E+00, 0.53678E+00, + & 0.54136E+00, 0.54593E+00, 0.55049E+00, 0.55504E+00, 0.55959E+00, + & 0.56412E+00, 0.56864E+00, 0.57316E+00, 0.57766E+00, 0.58216E+00/ + + DATA (BNC12M (I),I=201,300)/ + & 0.58664E+00, 0.59112E+00, 0.59558E+00, 0.60004E+00, 0.60449E+00, + & 0.60893E+00, 0.61336E+00, 0.61778E+00, 0.62219E+00, 0.62659E+00, + & 0.63098E+00, 0.63536E+00, 0.63973E+00, 0.64410E+00, 0.64845E+00, + & 0.65280E+00, 0.65714E+00, 0.66146E+00, 0.66578E+00, 0.67009E+00, + & 0.67439E+00, 0.67869E+00, 0.68297E+00, 0.68724E+00, 0.69151E+00, + & 0.69576E+00, 0.70001E+00, 0.70425E+00, 0.70848E+00, 0.71270E+00, + & 0.71691E+00, 0.72111E+00, 0.72531E+00, 0.72950E+00, 0.73367E+00, + & 0.73784E+00, 0.74200E+00, 0.74616E+00, 0.75030E+00, 0.75443E+00, + & 0.75856E+00, 0.76268E+00, 0.76679E+00, 0.77089E+00, 0.77498E+00, + & 0.77907E+00, 0.78314E+00, 0.78721E+00, 0.79127E+00, 0.79532E+00, + & 0.79937E+00, 0.80340E+00, 0.80743E+00, 0.81145E+00, 0.81546E+00, + & 0.81946E+00, 0.82346E+00, 0.82745E+00, 0.83143E+00, 0.83540E+00, + & 0.83936E+00, 0.84332E+00, 0.84726E+00, 0.85120E+00, 0.85514E+00, + & 0.85906E+00, 0.86298E+00, 0.86689E+00, 0.87079E+00, 0.87468E+00, + & 0.87857E+00, 0.88245E+00, 0.88632E+00, 0.89018E+00, 0.89404E+00, + & 0.89788E+00, 0.90173E+00, 0.90556E+00, 0.90939E+00, 0.91320E+00, + & 0.91702E+00, 0.92082E+00, 0.92462E+00, 0.92840E+00, 0.93219E+00, + & 0.93596E+00, 0.93973E+00, 0.94349E+00, 0.94724E+00, 0.95099E+00, + & 0.95473E+00, 0.95846E+00, 0.96219E+00, 0.96590E+00, 0.96961E+00, + & 0.97332E+00, 0.97702E+00, 0.98071E+00, 0.98439E+00, 0.98807E+00/ + + DATA (BNC12M (I),I=301,400)/ + & 0.99173E+00, 0.99540E+00, 0.99905E+00, 0.10027E+01, 0.10063E+01, + & 0.10100E+01, 0.10136E+01, 0.10172E+01, 0.10208E+01, 0.10245E+01, + & 0.10281E+01, 0.10316E+01, 0.10352E+01, 0.10388E+01, 0.10424E+01, + & 0.10460E+01, 0.10495E+01, 0.10531E+01, 0.10566E+01, 0.10602E+01, + & 0.10637E+01, 0.10672E+01, 0.10708E+01, 0.10743E+01, 0.10778E+01, + & 0.10813E+01, 0.10848E+01, 0.10883E+01, 0.10918E+01, 0.10953E+01, + & 0.10987E+01, 0.11022E+01, 0.11057E+01, 0.11091E+01, 0.11126E+01, + & 0.11160E+01, 0.11194E+01, 0.11229E+01, 0.11263E+01, 0.11297E+01, + & 0.11331E+01, 0.11365E+01, 0.11399E+01, 0.11433E+01, 0.11467E+01, + & 0.11501E+01, 0.11535E+01, 0.11569E+01, 0.11602E+01, 0.11636E+01, + & 0.11669E+01, 0.11703E+01, 0.11736E+01, 0.11770E+01, 0.11803E+01, + & 0.11836E+01, 0.11869E+01, 0.11902E+01, 0.11935E+01, 0.11969E+01, + & 0.12001E+01, 0.12034E+01, 0.12067E+01, 0.12100E+01, 0.12133E+01, + & 0.12165E+01, 0.12198E+01, 0.12231E+01, 0.12263E+01, 0.12296E+01, + & 0.12328E+01, 0.12360E+01, 0.12393E+01, 0.12425E+01, 0.12457E+01, + & 0.12489E+01, 0.12521E+01, 0.12553E+01, 0.12585E+01, 0.12617E+01, + & 0.12649E+01, 0.12681E+01, 0.12713E+01, 0.12744E+01, 0.12776E+01, + & 0.12808E+01, 0.12839E+01, 0.12871E+01, 0.12902E+01, 0.12934E+01, + & 0.12965E+01, 0.12996E+01, 0.13028E+01, 0.13059E+01, 0.13090E+01, + & 0.13121E+01, 0.13152E+01, 0.13183E+01, 0.13214E+01, 0.13245E+01/ + + DATA (BNC12M (I),I=401,500)/ + & 0.13276E+01, 0.13307E+01, 0.13337E+01, 0.13368E+01, 0.13399E+01, + & 0.13429E+01, 0.13460E+01, 0.13490E+01, 0.13521E+01, 0.13551E+01, + & 0.13581E+01, 0.13612E+01, 0.13642E+01, 0.13672E+01, 0.13702E+01, + & 0.13733E+01, 0.13763E+01, 0.13793E+01, 0.13823E+01, 0.13853E+01, + & 0.13882E+01, 0.13912E+01, 0.13942E+01, 0.13972E+01, 0.14001E+01, + & 0.14031E+01, 0.14061E+01, 0.14090E+01, 0.14120E+01, 0.14149E+01, + & 0.14179E+01, 0.14208E+01, 0.14237E+01, 0.14267E+01, 0.14296E+01, + & 0.14325E+01, 0.14354E+01, 0.14383E+01, 0.14412E+01, 0.14441E+01, + & 0.14470E+01, 0.14499E+01, 0.14528E+01, 0.14557E+01, 0.14586E+01, + & 0.14614E+01, 0.14643E+01, 0.14672E+01, 0.14700E+01, 0.14729E+01, + & 0.14758E+01, 0.14786E+01, 0.14815E+01, 0.14843E+01, 0.14871E+01, + & 0.14900E+01, 0.14928E+01, 0.14956E+01, 0.14984E+01, 0.15012E+01, + & 0.15041E+01, 0.15069E+01, 0.15097E+01, 0.15125E+01, 0.15153E+01, + & 0.15180E+01, 0.15208E+01, 0.15236E+01, 0.15264E+01, 0.15292E+01, + & 0.15319E+01, 0.15347E+01, 0.15375E+01, 0.15402E+01, 0.15430E+01, + & 0.15457E+01, 0.15485E+01, 0.15512E+01, 0.15539E+01, 0.15567E+01, + & 0.15594E+01, 0.15621E+01, 0.15648E+01, 0.15676E+01, 0.15703E+01, + & 0.15730E+01, 0.15757E+01, 0.15784E+01, 0.15811E+01, 0.15838E+01, + & 0.15865E+01, 0.15892E+01, 0.15918E+01, 0.15945E+01, 0.15972E+01, + & 0.15999E+01, 0.16025E+01, 0.16052E+01, 0.16079E+01, 0.16105E+01/ + + DATA (BNC12M (I),I=501,600)/ + & 0.16132E+01, 0.16158E+01, 0.16185E+01, 0.16211E+01, 0.16237E+01, + & 0.16264E+01, 0.16290E+01, 0.16316E+01, 0.16342E+01, 0.16369E+01, + & 0.16395E+01, 0.16421E+01, 0.16447E+01, 0.16473E+01, 0.16499E+01, + & 0.16525E+01, 0.16551E+01, 0.16577E+01, 0.16603E+01, 0.16628E+01, + & 0.16654E+01, 0.16680E+01, 0.16706E+01, 0.16731E+01, 0.16757E+01, + & 0.16783E+01, 0.16808E+01, 0.16834E+01, 0.16859E+01, 0.16885E+01, + & 0.16910E+01, 0.16935E+01, 0.16961E+01, 0.16986E+01, 0.17011E+01, + & 0.17037E+01, 0.17062E+01, 0.17087E+01, 0.17112E+01, 0.17137E+01, + & 0.17162E+01, 0.17188E+01, 0.17213E+01, 0.17238E+01, 0.17263E+01, + & 0.17287E+01, 0.17312E+01, 0.17337E+01, 0.17362E+01, 0.17387E+01, + & 0.17412E+01, 0.17436E+01, 0.17461E+01, 0.17486E+01, 0.17510E+01, + & 0.17535E+01, 0.17559E+01, 0.17584E+01, 0.17608E+01, 0.17633E+01, + & 0.17657E+01, 0.17682E+01, 0.17706E+01, 0.17730E+01, 0.17755E+01, + & 0.17779E+01, 0.17803E+01, 0.17827E+01, 0.17851E+01, 0.17876E+01, + & 0.17900E+01, 0.17924E+01, 0.17948E+01, 0.17972E+01, 0.17996E+01, + & 0.18020E+01, 0.18044E+01, 0.18068E+01, 0.18091E+01, 0.18115E+01, + & 0.18139E+01, 0.18163E+01, 0.18187E+01, 0.18210E+01, 0.18234E+01, + & 0.18258E+01, 0.18281E+01, 0.18305E+01, 0.18328E+01, 0.18352E+01, + & 0.18375E+01, 0.18399E+01, 0.18422E+01, 0.18446E+01, 0.18469E+01, + & 0.18492E+01, 0.18516E+01, 0.18539E+01, 0.18562E+01, 0.18649E+01/ + + DATA (BNC12M (I),I=601,700)/ + & 0.18839E+01, 0.19066E+01, 0.19291E+01, 0.19513E+01, 0.19732E+01, + & 0.19949E+01, 0.20163E+01, 0.20374E+01, 0.20583E+01, 0.20790E+01, + & 0.20994E+01, 0.21196E+01, 0.21396E+01, 0.21594E+01, 0.21789E+01, + & 0.21982E+01, 0.22174E+01, 0.22363E+01, 0.22550E+01, 0.22735E+01, + & 0.22918E+01, 0.23100E+01, 0.23279E+01, 0.23457E+01, 0.23633E+01, + & 0.23807E+01, 0.23979E+01, 0.24150E+01, 0.24319E+01, 0.24487E+01, + & 0.24653E+01, 0.24817E+01, 0.24980E+01, 0.25141E+01, 0.25301E+01, + & 0.25459E+01, 0.25616E+01, 0.25771E+01, 0.25925E+01, 0.26078E+01, + & 0.26229E+01, 0.26379E+01, 0.26527E+01, 0.26675E+01, 0.26821E+01, + & 0.26965E+01, 0.27109E+01, 0.27251E+01, 0.27393E+01, 0.27532E+01, + & 0.27671E+01, 0.27809E+01, 0.27945E+01, 0.28081E+01, 0.28215E+01, + & 0.28349E+01, 0.28481E+01, 0.28612E+01, 0.28742E+01, 0.28871E+01, + & 0.28999E+01, 0.29126E+01, 0.29252E+01, 0.29378E+01, 0.29502E+01, + & 0.29625E+01, 0.29747E+01, 0.29869E+01, 0.29989E+01, 0.30109E+01, + & 0.30228E+01, 0.30346E+01, 0.30463E+01, 0.30579E+01, 0.30694E+01, + & 0.30809E+01, 0.30923E+01, 0.31036E+01, 0.31148E+01, 0.31259E+01, + & 0.31370E+01, 0.31480E+01, 0.31589E+01, 0.31697E+01, 0.31805E+01, + & 0.31912E+01, 0.32018E+01, 0.32123E+01, 0.32228E+01, 0.32332E+01, + & 0.32436E+01, 0.32538E+01, 0.32640E+01, 0.32742E+01, 0.32842E+01, + & 0.32943E+01, 0.33042E+01, 0.33141E+01, 0.33239E+01, 0.33336E+01/ + + DATA (BNC12M(I),I=701,741)/ + & 0.33433E+01, 0.33530E+01, 0.33626E+01, 0.33721E+01, 0.33815E+01, + & 0.33909E+01, 0.34003E+01, 0.34095E+01, 0.34188E+01, 0.34279E+01, + & 0.34371E+01, 0.34461E+01, 0.34551E+01, 0.34641E+01, 0.34730E+01, + & 0.34819E+01, 0.34907E+01, 0.34994E+01, 0.35081E+01, 0.35167E+01, + & 0.35253E+01, 0.35339E+01, 0.35424E+01, 0.35508E+01, 0.35592E+01, + & 0.35676E+01, 0.35759E+01, 0.35842E+01, 0.35924E+01, 0.36006E+01, + & 0.36087E+01, 0.36168E+01, 0.36248E+01, 0.36328E+01, 0.36408E+01, + & 0.36487E+01, 0.36565E+01, 0.36644E+01, 0.36721E+01, 0.36799E+01, + & 0.36876E+01 + & / +C +C *** (NH4)3H(SO4)2 +C + DATA (BNC13M (I),I= 1,100)/ + &-0.84167E-01,-0.15304E+00,-0.20142E+00,-0.23431E+00,-0.25963E+00, + &-0.28033E+00,-0.29790E+00,-0.31317E+00,-0.32669E+00,-0.33881E+00, + &-0.34980E+00,-0.35984E+00,-0.36908E+00,-0.37764E+00,-0.38559E+00, + &-0.39302E+00,-0.39999E+00,-0.40654E+00,-0.41272E+00,-0.41855E+00, + &-0.42408E+00,-0.42933E+00,-0.43431E+00,-0.43905E+00,-0.44357E+00, + &-0.44789E+00,-0.45200E+00,-0.45594E+00,-0.45971E+00,-0.46332E+00, + &-0.46677E+00,-0.47008E+00,-0.47326E+00,-0.47631E+00,-0.47923E+00, + &-0.48204E+00,-0.48474E+00,-0.48734E+00,-0.48983E+00,-0.49223E+00, + &-0.49453E+00,-0.49675E+00,-0.49888E+00,-0.50093E+00,-0.50290E+00, + &-0.50480E+00,-0.50662E+00,-0.50838E+00,-0.51007E+00,-0.51169E+00, + &-0.51325E+00,-0.51476E+00,-0.51620E+00,-0.51759E+00,-0.51893E+00, + &-0.52021E+00,-0.52145E+00,-0.52263E+00,-0.52378E+00,-0.52487E+00, + &-0.52592E+00,-0.52693E+00,-0.52790E+00,-0.52883E+00,-0.52972E+00, + &-0.53058E+00,-0.53139E+00,-0.53218E+00,-0.53292E+00,-0.53364E+00, + &-0.53432E+00,-0.53498E+00,-0.53560E+00,-0.53619E+00,-0.53675E+00, + &-0.53729E+00,-0.53780E+00,-0.53828E+00,-0.53873E+00,-0.53916E+00, + &-0.53956E+00,-0.53994E+00,-0.54030E+00,-0.54063E+00,-0.54094E+00, + &-0.54122E+00,-0.54148E+00,-0.54173E+00,-0.54195E+00,-0.54215E+00, + &-0.54232E+00,-0.54248E+00,-0.54262E+00,-0.54275E+00,-0.54285E+00, + &-0.54293E+00,-0.54300E+00,-0.54305E+00,-0.54308E+00,-0.54310E+00/ + + DATA (BNC13M (I),I=101,200)/ + &-0.54310E+00,-0.54309E+00,-0.54306E+00,-0.54302E+00,-0.54296E+00, + &-0.54289E+00,-0.54281E+00,-0.54272E+00,-0.54261E+00,-0.54249E+00, + &-0.54236E+00,-0.54222E+00,-0.54207E+00,-0.54191E+00,-0.54174E+00, + &-0.54156E+00,-0.54137E+00,-0.54117E+00,-0.54097E+00,-0.54075E+00, + &-0.54062E+00,-0.54039E+00,-0.54014E+00,-0.53989E+00,-0.53964E+00, + &-0.53937E+00,-0.53911E+00,-0.53884E+00,-0.53856E+00,-0.53828E+00, + &-0.53800E+00,-0.53771E+00,-0.53742E+00,-0.53712E+00,-0.53682E+00, + &-0.53652E+00,-0.53621E+00,-0.53590E+00,-0.53559E+00,-0.53527E+00, + &-0.53495E+00,-0.53463E+00,-0.53430E+00,-0.53397E+00,-0.53364E+00, + &-0.53331E+00,-0.53297E+00,-0.53264E+00,-0.53230E+00,-0.53195E+00, + &-0.53161E+00,-0.53126E+00,-0.53092E+00,-0.53057E+00,-0.53022E+00, + &-0.52986E+00,-0.52951E+00,-0.52915E+00,-0.52879E+00,-0.52844E+00, + &-0.52808E+00,-0.52771E+00,-0.52735E+00,-0.52699E+00,-0.52662E+00, + &-0.52626E+00,-0.52589E+00,-0.52552E+00,-0.52515E+00,-0.52479E+00, + &-0.52442E+00,-0.52404E+00,-0.52367E+00,-0.52330E+00,-0.52293E+00, + &-0.52255E+00,-0.52218E+00,-0.52181E+00,-0.52143E+00,-0.52106E+00, + &-0.52068E+00,-0.52030E+00,-0.51993E+00,-0.51955E+00,-0.51918E+00, + &-0.51880E+00,-0.51842E+00,-0.51804E+00,-0.51767E+00,-0.51729E+00, + &-0.51691E+00,-0.51653E+00,-0.51615E+00,-0.51577E+00,-0.51540E+00, + &-0.51502E+00,-0.51464E+00,-0.51426E+00,-0.51388E+00,-0.51351E+00/ + + DATA (BNC13M (I),I=201,300)/ + &-0.51313E+00,-0.51275E+00,-0.51237E+00,-0.51199E+00,-0.51162E+00, + &-0.51124E+00,-0.51086E+00,-0.51049E+00,-0.51011E+00,-0.50973E+00, + &-0.50936E+00,-0.50898E+00,-0.50860E+00,-0.50823E+00,-0.50785E+00, + &-0.50748E+00,-0.50710E+00,-0.50673E+00,-0.50636E+00,-0.50598E+00, + &-0.50561E+00,-0.50524E+00,-0.50486E+00,-0.50449E+00,-0.50412E+00, + &-0.50375E+00,-0.50338E+00,-0.50301E+00,-0.50264E+00,-0.50227E+00, + &-0.50190E+00,-0.50153E+00,-0.50116E+00,-0.50079E+00,-0.50043E+00, + &-0.50006E+00,-0.49969E+00,-0.49933E+00,-0.49896E+00,-0.49860E+00, + &-0.49823E+00,-0.49787E+00,-0.49750E+00,-0.49714E+00,-0.49678E+00, + &-0.49642E+00,-0.49606E+00,-0.49569E+00,-0.49533E+00,-0.49497E+00, + &-0.49461E+00,-0.49426E+00,-0.49390E+00,-0.49354E+00,-0.49318E+00, + &-0.49283E+00,-0.49247E+00,-0.49211E+00,-0.49176E+00,-0.49141E+00, + &-0.49105E+00,-0.49070E+00,-0.49035E+00,-0.48999E+00,-0.48964E+00, + &-0.48929E+00,-0.48894E+00,-0.48859E+00,-0.48824E+00,-0.48789E+00, + &-0.48755E+00,-0.48720E+00,-0.48685E+00,-0.48651E+00,-0.48616E+00, + &-0.48581E+00,-0.48547E+00,-0.48513E+00,-0.48478E+00,-0.48444E+00, + &-0.48410E+00,-0.48376E+00,-0.48342E+00,-0.48308E+00,-0.48274E+00, + &-0.48240E+00,-0.48206E+00,-0.48172E+00,-0.48138E+00,-0.48105E+00, + &-0.48071E+00,-0.48038E+00,-0.48004E+00,-0.47971E+00,-0.47938E+00, + &-0.47904E+00,-0.47871E+00,-0.47838E+00,-0.47805E+00,-0.47772E+00/ + + DATA (BNC13M (I),I=301,400)/ + &-0.47739E+00,-0.47706E+00,-0.47673E+00,-0.47640E+00,-0.47608E+00, + &-0.47575E+00,-0.47542E+00,-0.47510E+00,-0.47477E+00,-0.47445E+00, + &-0.47413E+00,-0.47380E+00,-0.47348E+00,-0.47316E+00,-0.47284E+00, + &-0.47252E+00,-0.47220E+00,-0.47188E+00,-0.47156E+00,-0.47124E+00, + &-0.47093E+00,-0.47061E+00,-0.47029E+00,-0.46998E+00,-0.46966E+00, + &-0.46935E+00,-0.46903E+00,-0.46872E+00,-0.46841E+00,-0.46810E+00, + &-0.46779E+00,-0.46748E+00,-0.46717E+00,-0.46686E+00,-0.46655E+00, + &-0.46624E+00,-0.46593E+00,-0.46563E+00,-0.46532E+00,-0.46502E+00, + &-0.46471E+00,-0.46441E+00,-0.46410E+00,-0.46380E+00,-0.46350E+00, + &-0.46320E+00,-0.46289E+00,-0.46259E+00,-0.46229E+00,-0.46200E+00, + &-0.46170E+00,-0.46140E+00,-0.46110E+00,-0.46080E+00,-0.46051E+00, + &-0.46021E+00,-0.45992E+00,-0.45962E+00,-0.45933E+00,-0.45904E+00, + &-0.45874E+00,-0.45845E+00,-0.45816E+00,-0.45787E+00,-0.45758E+00, + &-0.45729E+00,-0.45700E+00,-0.45671E+00,-0.45642E+00,-0.45614E+00, + &-0.45585E+00,-0.45556E+00,-0.45528E+00,-0.45499E+00,-0.45471E+00, + &-0.45442E+00,-0.45414E+00,-0.45386E+00,-0.45358E+00,-0.45330E+00, + &-0.45302E+00,-0.45274E+00,-0.45246E+00,-0.45218E+00,-0.45190E+00, + &-0.45162E+00,-0.45134E+00,-0.45107E+00,-0.45079E+00,-0.45051E+00, + &-0.45024E+00,-0.44997E+00,-0.44969E+00,-0.44942E+00,-0.44915E+00, + &-0.44887E+00,-0.44860E+00,-0.44833E+00,-0.44806E+00,-0.44779E+00/ + + DATA (BNC13M (I),I=401,500)/ + &-0.44752E+00,-0.44725E+00,-0.44699E+00,-0.44672E+00,-0.44645E+00, + &-0.44619E+00,-0.44592E+00,-0.44565E+00,-0.44539E+00,-0.44513E+00, + &-0.44486E+00,-0.44460E+00,-0.44434E+00,-0.44408E+00,-0.44381E+00, + &-0.44355E+00,-0.44329E+00,-0.44303E+00,-0.44277E+00,-0.44252E+00, + &-0.44226E+00,-0.44200E+00,-0.44174E+00,-0.44149E+00,-0.44123E+00, + &-0.44098E+00,-0.44072E+00,-0.44047E+00,-0.44021E+00,-0.43996E+00, + &-0.43971E+00,-0.43946E+00,-0.43921E+00,-0.43896E+00,-0.43870E+00, + &-0.43846E+00,-0.43821E+00,-0.43796E+00,-0.43771E+00,-0.43746E+00, + &-0.43721E+00,-0.43697E+00,-0.43672E+00,-0.43648E+00,-0.43623E+00, + &-0.43599E+00,-0.43574E+00,-0.43550E+00,-0.43526E+00,-0.43502E+00, + &-0.43477E+00,-0.43453E+00,-0.43429E+00,-0.43405E+00,-0.43381E+00, + &-0.43357E+00,-0.43333E+00,-0.43310E+00,-0.43286E+00,-0.43262E+00, + &-0.43238E+00,-0.43215E+00,-0.43191E+00,-0.43168E+00,-0.43144E+00, + &-0.43121E+00,-0.43098E+00,-0.43074E+00,-0.43051E+00,-0.43028E+00, + &-0.43005E+00,-0.42982E+00,-0.42959E+00,-0.42936E+00,-0.42913E+00, + &-0.42890E+00,-0.42867E+00,-0.42844E+00,-0.42821E+00,-0.42799E+00, + &-0.42776E+00,-0.42754E+00,-0.42731E+00,-0.42708E+00,-0.42686E+00, + &-0.42664E+00,-0.42641E+00,-0.42619E+00,-0.42597E+00,-0.42575E+00, + &-0.42552E+00,-0.42530E+00,-0.42508E+00,-0.42486E+00,-0.42464E+00, + &-0.42442E+00,-0.42421E+00,-0.42399E+00,-0.42377E+00,-0.42355E+00/ + + DATA (BNC13M (I),I=501,600)/ + &-0.42334E+00,-0.42312E+00,-0.42290E+00,-0.42269E+00,-0.42248E+00, + &-0.42226E+00,-0.42205E+00,-0.42183E+00,-0.42162E+00,-0.42141E+00, + &-0.42120E+00,-0.42099E+00,-0.42077E+00,-0.42056E+00,-0.42035E+00, + &-0.42014E+00,-0.41994E+00,-0.41973E+00,-0.41952E+00,-0.41931E+00, + &-0.41910E+00,-0.41890E+00,-0.41869E+00,-0.41849E+00,-0.41828E+00, + &-0.41808E+00,-0.41787E+00,-0.41767E+00,-0.41746E+00,-0.41726E+00, + &-0.41706E+00,-0.41686E+00,-0.41665E+00,-0.41645E+00,-0.41625E+00, + &-0.41605E+00,-0.41585E+00,-0.41565E+00,-0.41545E+00,-0.41526E+00, + &-0.41506E+00,-0.41486E+00,-0.41466E+00,-0.41447E+00,-0.41427E+00, + &-0.41407E+00,-0.41388E+00,-0.41368E+00,-0.41349E+00,-0.41329E+00, + &-0.41310E+00,-0.41291E+00,-0.41272E+00,-0.41252E+00,-0.41233E+00, + &-0.41214E+00,-0.41195E+00,-0.41176E+00,-0.41157E+00,-0.41138E+00, + &-0.41119E+00,-0.41100E+00,-0.41081E+00,-0.41062E+00,-0.41044E+00, + &-0.41025E+00,-0.41006E+00,-0.40988E+00,-0.40969E+00,-0.40950E+00, + &-0.40932E+00,-0.40914E+00,-0.40895E+00,-0.40877E+00,-0.40858E+00, + &-0.40840E+00,-0.40822E+00,-0.40804E+00,-0.40785E+00,-0.40767E+00, + &-0.40749E+00,-0.40731E+00,-0.40713E+00,-0.40695E+00,-0.40677E+00, + &-0.40659E+00,-0.40642E+00,-0.40624E+00,-0.40606E+00,-0.40588E+00, + &-0.40571E+00,-0.40553E+00,-0.40535E+00,-0.40518E+00,-0.40500E+00, + &-0.40483E+00,-0.40466E+00,-0.40448E+00,-0.40431E+00,-0.40366E+00/ + + DATA (BNC13M (I),I=601,700)/ + &-0.40226E+00,-0.40059E+00,-0.39896E+00,-0.39738E+00,-0.39582E+00, + &-0.39431E+00,-0.39283E+00,-0.39138E+00,-0.38998E+00,-0.38860E+00, + &-0.38726E+00,-0.38595E+00,-0.38467E+00,-0.38343E+00,-0.38221E+00, + &-0.38103E+00,-0.37988E+00,-0.37876E+00,-0.37766E+00,-0.37660E+00, + &-0.37556E+00,-0.37455E+00,-0.37357E+00,-0.37261E+00,-0.37169E+00, + &-0.37078E+00,-0.36991E+00,-0.36906E+00,-0.36823E+00,-0.36743E+00, + &-0.36665E+00,-0.36590E+00,-0.36516E+00,-0.36446E+00,-0.36377E+00, + &-0.36311E+00,-0.36247E+00,-0.36185E+00,-0.36125E+00,-0.36067E+00, + &-0.36012E+00,-0.35958E+00,-0.35907E+00,-0.35857E+00,-0.35809E+00, + &-0.35764E+00,-0.35720E+00,-0.35678E+00,-0.35638E+00,-0.35600E+00, + &-0.35563E+00,-0.35529E+00,-0.35496E+00,-0.35465E+00,-0.35435E+00, + &-0.35407E+00,-0.35381E+00,-0.35357E+00,-0.35334E+00,-0.35313E+00, + &-0.35293E+00,-0.35275E+00,-0.35258E+00,-0.35243E+00,-0.35229E+00, + &-0.35217E+00,-0.35206E+00,-0.35197E+00,-0.35189E+00,-0.35183E+00, + &-0.35178E+00,-0.35174E+00,-0.35172E+00,-0.35171E+00,-0.35171E+00, + &-0.35173E+00,-0.35176E+00,-0.35180E+00,-0.35186E+00,-0.35193E+00, + &-0.35201E+00,-0.35210E+00,-0.35220E+00,-0.35232E+00,-0.35245E+00, + &-0.35258E+00,-0.35274E+00,-0.35290E+00,-0.35307E+00,-0.35326E+00, + &-0.35345E+00,-0.35366E+00,-0.35387E+00,-0.35410E+00,-0.35434E+00, + &-0.35459E+00,-0.35485E+00,-0.35512E+00,-0.35540E+00,-0.35569E+00/ + + DATA (BNC13M(I),I=701,741)/ + &-0.35599E+00,-0.35629E+00,-0.35661E+00,-0.35694E+00,-0.35728E+00, + &-0.35763E+00,-0.35798E+00,-0.35835E+00,-0.35872E+00,-0.35911E+00, + &-0.35950E+00,-0.35990E+00,-0.36031E+00,-0.36073E+00,-0.36116E+00, + &-0.36159E+00,-0.36204E+00,-0.36249E+00,-0.36295E+00,-0.36342E+00, + &-0.36390E+00,-0.36438E+00,-0.36487E+00,-0.36538E+00,-0.36588E+00, + &-0.36640E+00,-0.36692E+00,-0.36746E+00,-0.36799E+00,-0.36854E+00, + &-0.36909E+00,-0.36966E+00,-0.37022E+00,-0.37080E+00,-0.37138E+00, + &-0.37197E+00,-0.37257E+00,-0.37317E+00,-0.37378E+00,-0.37440E+00, + &-0.37502E+00 + & / + END + +C *** TEMP = 298.0 + + BLOCK DATA KMCF298 +C +C *** Common block definition +C + COMMON /KMC298/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) +C +C *** NaCl +C + DATA (BNC01M (I),I= 1,100)/ + &-0.49998E-01,-0.88352E-01,-0.11333E+00,-0.12907E+00,-0.14035E+00, + &-0.14892E+00,-0.15567E+00,-0.16110E+00,-0.16552E+00,-0.16915E+00, + &-0.17214E+00,-0.17461E+00,-0.17663E+00,-0.17828E+00,-0.17961E+00, + &-0.18066E+00,-0.18146E+00,-0.18205E+00,-0.18245E+00,-0.18268E+00, + &-0.18276E+00,-0.18270E+00,-0.18252E+00,-0.18222E+00,-0.18183E+00, + &-0.18134E+00,-0.18077E+00,-0.18013E+00,-0.17941E+00,-0.17864E+00, + &-0.17780E+00,-0.17691E+00,-0.17598E+00,-0.17500E+00,-0.17397E+00, + &-0.17292E+00,-0.17182E+00,-0.17070E+00,-0.16955E+00,-0.16837E+00, + &-0.16717E+00,-0.16594E+00,-0.16470E+00,-0.16343E+00,-0.16215E+00, + &-0.16086E+00,-0.15955E+00,-0.15823E+00,-0.15690E+00,-0.15555E+00, + &-0.15420E+00,-0.15283E+00,-0.15146E+00,-0.15008E+00,-0.14869E+00, + &-0.14729E+00,-0.14589E+00,-0.14448E+00,-0.14306E+00,-0.14163E+00, + &-0.14020E+00,-0.13877E+00,-0.13732E+00,-0.13587E+00,-0.13441E+00, + &-0.13294E+00,-0.13147E+00,-0.12999E+00,-0.12850E+00,-0.12700E+00, + &-0.12549E+00,-0.12397E+00,-0.12245E+00,-0.12091E+00,-0.11936E+00, + &-0.11781E+00,-0.11624E+00,-0.11466E+00,-0.11307E+00,-0.11147E+00, + &-0.10985E+00,-0.10823E+00,-0.10659E+00,-0.10493E+00,-0.10327E+00, + &-0.10159E+00,-0.99900E-01,-0.98196E-01,-0.96479E-01,-0.94748E-01, + &-0.93005E-01,-0.91248E-01,-0.89479E-01,-0.87697E-01,-0.85902E-01, + &-0.84096E-01,-0.82277E-01,-0.80446E-01,-0.78604E-01,-0.76751E-01/ + + DATA (BNC01M (I),I=101,200)/ + &-0.74887E-01,-0.73013E-01,-0.71128E-01,-0.69234E-01,-0.67331E-01, + &-0.65418E-01,-0.63498E-01,-0.61569E-01,-0.59633E-01,-0.57689E-01, + &-0.55739E-01,-0.53782E-01,-0.51819E-01,-0.49851E-01,-0.47877E-01, + &-0.45899E-01,-0.43917E-01,-0.41930E-01,-0.39940E-01,-0.37946E-01, + &-0.36169E-01,-0.34144E-01,-0.32120E-01,-0.30095E-01,-0.28071E-01, + &-0.26048E-01,-0.24024E-01,-0.22002E-01,-0.19979E-01,-0.17958E-01, + &-0.15937E-01,-0.13916E-01,-0.11897E-01,-0.98784E-02,-0.78606E-02, + &-0.58439E-02,-0.38280E-02,-0.18133E-02, 0.20048E-03, 0.22131E-02, + & 0.42245E-02, 0.62347E-02, 0.82436E-02, 0.10251E-01, 0.12258E-01, + & 0.14263E-01, 0.16266E-01, 0.18268E-01, 0.20269E-01, 0.22268E-01, + & 0.24266E-01, 0.26262E-01, 0.28256E-01, 0.30249E-01, 0.32240E-01, + & 0.34229E-01, 0.36217E-01, 0.38203E-01, 0.40187E-01, 0.42170E-01, + & 0.44150E-01, 0.46129E-01, 0.48106E-01, 0.50081E-01, 0.52054E-01, + & 0.54025E-01, 0.55994E-01, 0.57961E-01, 0.59926E-01, 0.61889E-01, + & 0.63850E-01, 0.65809E-01, 0.67766E-01, 0.69721E-01, 0.71674E-01, + & 0.73625E-01, 0.75573E-01, 0.77519E-01, 0.79464E-01, 0.81406E-01, + & 0.83345E-01, 0.85283E-01, 0.87218E-01, 0.89152E-01, 0.91082E-01, + & 0.93011E-01, 0.94937E-01, 0.96862E-01, 0.98783E-01, 0.10070E+00, + & 0.10262E+00, 0.10453E+00, 0.10645E+00, 0.10836E+00, 0.11027E+00, + & 0.11217E+00, 0.11407E+00, 0.11597E+00, 0.11787E+00, 0.11977E+00/ + + DATA (BNC01M (I),I=201,300)/ + & 0.12166E+00, 0.12355E+00, 0.12544E+00, 0.12733E+00, 0.12921E+00, + & 0.13109E+00, 0.13297E+00, 0.13485E+00, 0.13672E+00, 0.13860E+00, + & 0.14047E+00, 0.14233E+00, 0.14420E+00, 0.14606E+00, 0.14792E+00, + & 0.14978E+00, 0.15163E+00, 0.15348E+00, 0.15533E+00, 0.15718E+00, + & 0.15902E+00, 0.16087E+00, 0.16271E+00, 0.16454E+00, 0.16638E+00, + & 0.16821E+00, 0.17004E+00, 0.17187E+00, 0.17369E+00, 0.17551E+00, + & 0.17733E+00, 0.17915E+00, 0.18097E+00, 0.18278E+00, 0.18459E+00, + & 0.18640E+00, 0.18820E+00, 0.19000E+00, 0.19180E+00, 0.19360E+00, + & 0.19540E+00, 0.19719E+00, 0.19898E+00, 0.20076E+00, 0.20255E+00, + & 0.20433E+00, 0.20611E+00, 0.20789E+00, 0.20966E+00, 0.21144E+00, + & 0.21321E+00, 0.21497E+00, 0.21674E+00, 0.21850E+00, 0.22026E+00, + & 0.22202E+00, 0.22377E+00, 0.22553E+00, 0.22727E+00, 0.22902E+00, + & 0.23077E+00, 0.23251E+00, 0.23425E+00, 0.23599E+00, 0.23772E+00, + & 0.23946E+00, 0.24119E+00, 0.24291E+00, 0.24464E+00, 0.24636E+00, + & 0.24808E+00, 0.24980E+00, 0.25152E+00, 0.25323E+00, 0.25494E+00, + & 0.25665E+00, 0.25835E+00, 0.26006E+00, 0.26176E+00, 0.26346E+00, + & 0.26515E+00, 0.26684E+00, 0.26854E+00, 0.27022E+00, 0.27191E+00, + & 0.27360E+00, 0.27528E+00, 0.27696E+00, 0.27863E+00, 0.28031E+00, + & 0.28198E+00, 0.28365E+00, 0.28532E+00, 0.28698E+00, 0.28864E+00, + & 0.29030E+00, 0.29196E+00, 0.29362E+00, 0.29527E+00, 0.29692E+00/ + + DATA (BNC01M (I),I=301,400)/ + & 0.29857E+00, 0.30021E+00, 0.30186E+00, 0.30350E+00, 0.30514E+00, + & 0.30677E+00, 0.30841E+00, 0.31004E+00, 0.31167E+00, 0.31330E+00, + & 0.31492E+00, 0.31654E+00, 0.31816E+00, 0.31978E+00, 0.32140E+00, + & 0.32301E+00, 0.32462E+00, 0.32623E+00, 0.32784E+00, 0.32944E+00, + & 0.33104E+00, 0.33264E+00, 0.33424E+00, 0.33584E+00, 0.33743E+00, + & 0.33902E+00, 0.34061E+00, 0.34219E+00, 0.34378E+00, 0.34536E+00, + & 0.34694E+00, 0.34852E+00, 0.35009E+00, 0.35166E+00, 0.35323E+00, + & 0.35480E+00, 0.35637E+00, 0.35793E+00, 0.35949E+00, 0.36105E+00, + & 0.36261E+00, 0.36417E+00, 0.36572E+00, 0.36727E+00, 0.36882E+00, + & 0.37036E+00, 0.37191E+00, 0.37345E+00, 0.37499E+00, 0.37653E+00, + & 0.37806E+00, 0.37960E+00, 0.38113E+00, 0.38266E+00, 0.38419E+00, + & 0.38571E+00, 0.38723E+00, 0.38875E+00, 0.39027E+00, 0.39179E+00, + & 0.39330E+00, 0.39482E+00, 0.39633E+00, 0.39783E+00, 0.39934E+00, + & 0.40084E+00, 0.40235E+00, 0.40384E+00, 0.40534E+00, 0.40684E+00, + & 0.40833E+00, 0.40982E+00, 0.41131E+00, 0.41280E+00, 0.41429E+00, + & 0.41577E+00, 0.41725E+00, 0.41873E+00, 0.42021E+00, 0.42168E+00, + & 0.42315E+00, 0.42463E+00, 0.42609E+00, 0.42756E+00, 0.42903E+00, + & 0.43049E+00, 0.43195E+00, 0.43341E+00, 0.43487E+00, 0.43632E+00, + & 0.43778E+00, 0.43923E+00, 0.44068E+00, 0.44212E+00, 0.44357E+00, + & 0.44501E+00, 0.44645E+00, 0.44789E+00, 0.44933E+00, 0.45077E+00/ + + DATA (BNC01M (I),I=401,500)/ + & 0.45220E+00, 0.45363E+00, 0.45506E+00, 0.45649E+00, 0.45792E+00, + & 0.45934E+00, 0.46076E+00, 0.46218E+00, 0.46360E+00, 0.46502E+00, + & 0.46643E+00, 0.46784E+00, 0.46926E+00, 0.47066E+00, 0.47207E+00, + & 0.47348E+00, 0.47488E+00, 0.47628E+00, 0.47768E+00, 0.47908E+00, + & 0.48047E+00, 0.48187E+00, 0.48326E+00, 0.48465E+00, 0.48604E+00, + & 0.48743E+00, 0.48881E+00, 0.49019E+00, 0.49157E+00, 0.49295E+00, + & 0.49433E+00, 0.49571E+00, 0.49708E+00, 0.49845E+00, 0.49982E+00, + & 0.50119E+00, 0.50256E+00, 0.50392E+00, 0.50529E+00, 0.50665E+00, + & 0.50801E+00, 0.50937E+00, 0.51072E+00, 0.51208E+00, 0.51343E+00, + & 0.51478E+00, 0.51613E+00, 0.51748E+00, 0.51882E+00, 0.52017E+00, + & 0.52151E+00, 0.52285E+00, 0.52419E+00, 0.52553E+00, 0.52686E+00, + & 0.52819E+00, 0.52953E+00, 0.53086E+00, 0.53218E+00, 0.53351E+00, + & 0.53484E+00, 0.53616E+00, 0.53748E+00, 0.53880E+00, 0.54012E+00, + & 0.54144E+00, 0.54275E+00, 0.54406E+00, 0.54538E+00, 0.54669E+00, + & 0.54799E+00, 0.54930E+00, 0.55061E+00, 0.55191E+00, 0.55321E+00, + & 0.55451E+00, 0.55581E+00, 0.55711E+00, 0.55840E+00, 0.55970E+00, + & 0.56099E+00, 0.56228E+00, 0.56357E+00, 0.56485E+00, 0.56614E+00, + & 0.56742E+00, 0.56870E+00, 0.56999E+00, 0.57126E+00, 0.57254E+00, + & 0.57382E+00, 0.57509E+00, 0.57637E+00, 0.57764E+00, 0.57891E+00, + & 0.58017E+00, 0.58144E+00, 0.58271E+00, 0.58397E+00, 0.58523E+00/ + + DATA (BNC01M (I),I=501,600)/ + & 0.58649E+00, 0.58775E+00, 0.58901E+00, 0.59026E+00, 0.59152E+00, + & 0.59277E+00, 0.59402E+00, 0.59527E+00, 0.59652E+00, 0.59776E+00, + & 0.59901E+00, 0.60025E+00, 0.60149E+00, 0.60273E+00, 0.60397E+00, + & 0.60521E+00, 0.60645E+00, 0.60768E+00, 0.60891E+00, 0.61014E+00, + & 0.61137E+00, 0.61260E+00, 0.61383E+00, 0.61506E+00, 0.61628E+00, + & 0.61750E+00, 0.61872E+00, 0.61994E+00, 0.62116E+00, 0.62238E+00, + & 0.62359E+00, 0.62481E+00, 0.62602E+00, 0.62723E+00, 0.62844E+00, + & 0.62965E+00, 0.63085E+00, 0.63206E+00, 0.63326E+00, 0.63446E+00, + & 0.63567E+00, 0.63687E+00, 0.63806E+00, 0.63926E+00, 0.64045E+00, + & 0.64165E+00, 0.64284E+00, 0.64403E+00, 0.64522E+00, 0.64641E+00, + & 0.64760E+00, 0.64878E+00, 0.64997E+00, 0.65115E+00, 0.65233E+00, + & 0.65351E+00, 0.65469E+00, 0.65587E+00, 0.65704E+00, 0.65822E+00, + & 0.65939E+00, 0.66056E+00, 0.66173E+00, 0.66290E+00, 0.66407E+00, + & 0.66523E+00, 0.66640E+00, 0.66756E+00, 0.66872E+00, 0.66988E+00, + & 0.67104E+00, 0.67220E+00, 0.67336E+00, 0.67452E+00, 0.67567E+00, + & 0.67682E+00, 0.67797E+00, 0.67912E+00, 0.68027E+00, 0.68142E+00, + & 0.68257E+00, 0.68371E+00, 0.68486E+00, 0.68600E+00, 0.68714E+00, + & 0.68828E+00, 0.68942E+00, 0.69056E+00, 0.69169E+00, 0.69283E+00, + & 0.69396E+00, 0.69509E+00, 0.69622E+00, 0.69735E+00, 0.69848E+00, + & 0.69961E+00, 0.70073E+00, 0.70186E+00, 0.70298E+00, 0.70718E+00/ + + DATA (BNC01M (I),I=601,700)/ + & 0.71636E+00, 0.72738E+00, 0.73828E+00, 0.74906E+00, 0.75972E+00, + & 0.77027E+00, 0.78071E+00, 0.79104E+00, 0.80127E+00, 0.81139E+00, + & 0.82141E+00, 0.83133E+00, 0.84115E+00, 0.85087E+00, 0.86050E+00, + & 0.87004E+00, 0.87948E+00, 0.88883E+00, 0.89810E+00, 0.90728E+00, + & 0.91638E+00, 0.92539E+00, 0.93432E+00, 0.94316E+00, 0.95193E+00, + & 0.96063E+00, 0.96924E+00, 0.97778E+00, 0.98625E+00, 0.99464E+00, + & 0.10030E+01, 0.10112E+01, 0.10194E+01, 0.10275E+01, 0.10356E+01, + & 0.10435E+01, 0.10515E+01, 0.10593E+01, 0.10671E+01, 0.10748E+01, + & 0.10825E+01, 0.10901E+01, 0.10977E+01, 0.11051E+01, 0.11126E+01, + & 0.11200E+01, 0.11273E+01, 0.11345E+01, 0.11418E+01, 0.11489E+01, + & 0.11560E+01, 0.11631E+01, 0.11701E+01, 0.11770E+01, 0.11839E+01, + & 0.11908E+01, 0.11976E+01, 0.12044E+01, 0.12111E+01, 0.12177E+01, + & 0.12244E+01, 0.12309E+01, 0.12375E+01, 0.12440E+01, 0.12504E+01, + & 0.12568E+01, 0.12632E+01, 0.12695E+01, 0.12758E+01, 0.12820E+01, + & 0.12882E+01, 0.12943E+01, 0.13005E+01, 0.13065E+01, 0.13126E+01, + & 0.13186E+01, 0.13246E+01, 0.13305E+01, 0.13364E+01, 0.13422E+01, + & 0.13481E+01, 0.13539E+01, 0.13596E+01, 0.13653E+01, 0.13710E+01, + & 0.13767E+01, 0.13823E+01, 0.13879E+01, 0.13934E+01, 0.13990E+01, + & 0.14044E+01, 0.14099E+01, 0.14153E+01, 0.14207E+01, 0.14261E+01, + & 0.14314E+01, 0.14368E+01, 0.14420E+01, 0.14473E+01, 0.14525E+01/ + + DATA (BNC01M(I),I=701,741)/ + & 0.14577E+01, 0.14629E+01, 0.14680E+01, 0.14731E+01, 0.14782E+01, + & 0.14833E+01, 0.14883E+01, 0.14933E+01, 0.14983E+01, 0.15033E+01, + & 0.15082E+01, 0.15131E+01, 0.15180E+01, 0.15228E+01, 0.15277E+01, + & 0.15325E+01, 0.15372E+01, 0.15420E+01, 0.15467E+01, 0.15515E+01, + & 0.15561E+01, 0.15608E+01, 0.15655E+01, 0.15701E+01, 0.15747E+01, + & 0.15793E+01, 0.15838E+01, 0.15884E+01, 0.15929E+01, 0.15974E+01, + & 0.16018E+01, 0.16063E+01, 0.16107E+01, 0.16151E+01, 0.16195E+01, + & 0.16239E+01, 0.16282E+01, 0.16326E+01, 0.16369E+01, 0.16412E+01, + & 0.16454E+01 + & / +C +C *** Na2SO4 +C + DATA (BNC02M (I),I= 1,100)/ + &-0.10298E+00,-0.18764E+00,-0.24726E+00,-0.28786E+00,-0.31914E+00, + &-0.34476E+00,-0.36652E+00,-0.38546E+00,-0.40225E+00,-0.41734E+00, + &-0.43104E+00,-0.44360E+00,-0.45519E+00,-0.46595E+00,-0.47599E+00, + &-0.48541E+00,-0.49427E+00,-0.50264E+00,-0.51057E+00,-0.51811E+00, + &-0.52529E+00,-0.53214E+00,-0.53869E+00,-0.54497E+00,-0.55100E+00, + &-0.55680E+00,-0.56238E+00,-0.56776E+00,-0.57295E+00,-0.57797E+00, + &-0.58283E+00,-0.58753E+00,-0.59209E+00,-0.59651E+00,-0.60081E+00, + &-0.60498E+00,-0.60904E+00,-0.61298E+00,-0.61683E+00,-0.62058E+00, + &-0.62423E+00,-0.62779E+00,-0.63127E+00,-0.63466E+00,-0.63798E+00, + &-0.64123E+00,-0.64440E+00,-0.64750E+00,-0.65054E+00,-0.65351E+00, + &-0.65642E+00,-0.65928E+00,-0.66208E+00,-0.66482E+00,-0.66751E+00, + &-0.67015E+00,-0.67275E+00,-0.67529E+00,-0.67779E+00,-0.68025E+00, + &-0.68267E+00,-0.68504E+00,-0.68738E+00,-0.68968E+00,-0.69194E+00, + &-0.69416E+00,-0.69636E+00,-0.69852E+00,-0.70064E+00,-0.70274E+00, + &-0.70481E+00,-0.70685E+00,-0.70886E+00,-0.71084E+00,-0.71280E+00, + &-0.71473E+00,-0.71663E+00,-0.71852E+00,-0.72038E+00,-0.72221E+00, + &-0.72403E+00,-0.72583E+00,-0.72760E+00,-0.72935E+00,-0.73109E+00, + &-0.73281E+00,-0.73450E+00,-0.73618E+00,-0.73785E+00,-0.73949E+00, + &-0.74112E+00,-0.74274E+00,-0.74434E+00,-0.74592E+00,-0.74749E+00, + &-0.74904E+00,-0.75058E+00,-0.75210E+00,-0.75361E+00,-0.75511E+00/ + + DATA (BNC02M (I),I=101,200)/ + &-0.75660E+00,-0.75807E+00,-0.75953E+00,-0.76097E+00,-0.76241E+00, + &-0.76383E+00,-0.76524E+00,-0.76664E+00,-0.76803E+00,-0.76940E+00, + &-0.77077E+00,-0.77212E+00,-0.77346E+00,-0.77479E+00,-0.77612E+00, + &-0.77743E+00,-0.77873E+00,-0.78002E+00,-0.78130E+00,-0.78257E+00, + &-0.78379E+00,-0.78505E+00,-0.78629E+00,-0.78753E+00,-0.78876E+00, + &-0.78997E+00,-0.79118E+00,-0.79238E+00,-0.79357E+00,-0.79475E+00, + &-0.79592E+00,-0.79708E+00,-0.79824E+00,-0.79939E+00,-0.80052E+00, + &-0.80165E+00,-0.80277E+00,-0.80389E+00,-0.80499E+00,-0.80609E+00, + &-0.80718E+00,-0.80827E+00,-0.80934E+00,-0.81041E+00,-0.81147E+00, + &-0.81253E+00,-0.81358E+00,-0.81462E+00,-0.81565E+00,-0.81668E+00, + &-0.81770E+00,-0.81871E+00,-0.81972E+00,-0.82072E+00,-0.82172E+00, + &-0.82270E+00,-0.82369E+00,-0.82466E+00,-0.82563E+00,-0.82660E+00, + &-0.82756E+00,-0.82851E+00,-0.82946E+00,-0.83040E+00,-0.83133E+00, + &-0.83227E+00,-0.83319E+00,-0.83411E+00,-0.83503E+00,-0.83593E+00, + &-0.83684E+00,-0.83774E+00,-0.83863E+00,-0.83952E+00,-0.84040E+00, + &-0.84128E+00,-0.84216E+00,-0.84303E+00,-0.84389E+00,-0.84475E+00, + &-0.84561E+00,-0.84646E+00,-0.84731E+00,-0.84815E+00,-0.84898E+00, + &-0.84982E+00,-0.85065E+00,-0.85147E+00,-0.85229E+00,-0.85311E+00, + &-0.85392E+00,-0.85473E+00,-0.85553E+00,-0.85633E+00,-0.85712E+00, + &-0.85792E+00,-0.85870E+00,-0.85949E+00,-0.86027E+00,-0.86104E+00/ + + DATA (BNC02M (I),I=201,300)/ + &-0.86182E+00,-0.86258E+00,-0.86335E+00,-0.86411E+00,-0.86487E+00, + &-0.86562E+00,-0.86637E+00,-0.86712E+00,-0.86786E+00,-0.86860E+00, + &-0.86934E+00,-0.87007E+00,-0.87080E+00,-0.87153E+00,-0.87225E+00, + &-0.87297E+00,-0.87369E+00,-0.87440E+00,-0.87511E+00,-0.87582E+00, + &-0.87652E+00,-0.87722E+00,-0.87792E+00,-0.87862E+00,-0.87931E+00, + &-0.88000E+00,-0.88068E+00,-0.88136E+00,-0.88204E+00,-0.88272E+00, + &-0.88340E+00,-0.88407E+00,-0.88473E+00,-0.88540E+00,-0.88606E+00, + &-0.88672E+00,-0.88738E+00,-0.88804E+00,-0.88869E+00,-0.88934E+00, + &-0.88998E+00,-0.89063E+00,-0.89127E+00,-0.89191E+00,-0.89254E+00, + &-0.89318E+00,-0.89381E+00,-0.89444E+00,-0.89506E+00,-0.89569E+00, + &-0.89631E+00,-0.89693E+00,-0.89754E+00,-0.89816E+00,-0.89877E+00, + &-0.89938E+00,-0.89998E+00,-0.90059E+00,-0.90119E+00,-0.90179E+00, + &-0.90239E+00,-0.90299E+00,-0.90358E+00,-0.90417E+00,-0.90476E+00, + &-0.90535E+00,-0.90593E+00,-0.90651E+00,-0.90709E+00,-0.90767E+00, + &-0.90825E+00,-0.90882E+00,-0.90939E+00,-0.90996E+00,-0.91053E+00, + &-0.91110E+00,-0.91166E+00,-0.91222E+00,-0.91278E+00,-0.91334E+00, + &-0.91389E+00,-0.91445E+00,-0.91500E+00,-0.91555E+00,-0.91610E+00, + &-0.91664E+00,-0.91719E+00,-0.91773E+00,-0.91827E+00,-0.91881E+00, + &-0.91935E+00,-0.91988E+00,-0.92042E+00,-0.92095E+00,-0.92148E+00, + &-0.92201E+00,-0.92253E+00,-0.92306E+00,-0.92358E+00,-0.92410E+00/ + + DATA (BNC02M (I),I=301,400)/ + &-0.92462E+00,-0.92514E+00,-0.92565E+00,-0.92617E+00,-0.92668E+00, + &-0.92719E+00,-0.92770E+00,-0.92821E+00,-0.92871E+00,-0.92922E+00, + &-0.92972E+00,-0.93022E+00,-0.93072E+00,-0.93122E+00,-0.93171E+00, + &-0.93221E+00,-0.93270E+00,-0.93319E+00,-0.93368E+00,-0.93417E+00, + &-0.93466E+00,-0.93515E+00,-0.93563E+00,-0.93611E+00,-0.93659E+00, + &-0.93707E+00,-0.93755E+00,-0.93803E+00,-0.93850E+00,-0.93898E+00, + &-0.93945E+00,-0.93992E+00,-0.94039E+00,-0.94086E+00,-0.94133E+00, + &-0.94179E+00,-0.94226E+00,-0.94272E+00,-0.94318E+00,-0.94364E+00, + &-0.94410E+00,-0.94456E+00,-0.94501E+00,-0.94547E+00,-0.94592E+00, + &-0.94637E+00,-0.94682E+00,-0.94727E+00,-0.94772E+00,-0.94817E+00, + &-0.94861E+00,-0.94906E+00,-0.94950E+00,-0.94994E+00,-0.95038E+00, + &-0.95082E+00,-0.95126E+00,-0.95170E+00,-0.95213E+00,-0.95257E+00, + &-0.95300E+00,-0.95343E+00,-0.95386E+00,-0.95429E+00,-0.95472E+00, + &-0.95515E+00,-0.95557E+00,-0.95600E+00,-0.95642E+00,-0.95685E+00, + &-0.95727E+00,-0.95769E+00,-0.95811E+00,-0.95853E+00,-0.95894E+00, + &-0.95936E+00,-0.95977E+00,-0.96019E+00,-0.96060E+00,-0.96101E+00, + &-0.96142E+00,-0.96183E+00,-0.96224E+00,-0.96265E+00,-0.96305E+00, + &-0.96346E+00,-0.96386E+00,-0.96427E+00,-0.96467E+00,-0.96507E+00, + &-0.96547E+00,-0.96587E+00,-0.96627E+00,-0.96666E+00,-0.96706E+00, + &-0.96745E+00,-0.96785E+00,-0.96824E+00,-0.96863E+00,-0.96902E+00/ + + DATA (BNC02M (I),I=401,500)/ + &-0.96941E+00,-0.96980E+00,-0.97019E+00,-0.97058E+00,-0.97096E+00, + &-0.97135E+00,-0.97173E+00,-0.97211E+00,-0.97250E+00,-0.97288E+00, + &-0.97326E+00,-0.97364E+00,-0.97402E+00,-0.97439E+00,-0.97477E+00, + &-0.97515E+00,-0.97552E+00,-0.97589E+00,-0.97627E+00,-0.97664E+00, + &-0.97701E+00,-0.97738E+00,-0.97775E+00,-0.97812E+00,-0.97849E+00, + &-0.97885E+00,-0.97922E+00,-0.97958E+00,-0.97995E+00,-0.98031E+00, + &-0.98067E+00,-0.98104E+00,-0.98140E+00,-0.98176E+00,-0.98212E+00, + &-0.98247E+00,-0.98283E+00,-0.98319E+00,-0.98354E+00,-0.98390E+00, + &-0.98425E+00,-0.98461E+00,-0.98496E+00,-0.98531E+00,-0.98566E+00, + &-0.98601E+00,-0.98636E+00,-0.98671E+00,-0.98706E+00,-0.98741E+00, + &-0.98775E+00,-0.98810E+00,-0.98844E+00,-0.98879E+00,-0.98913E+00, + &-0.98947E+00,-0.98981E+00,-0.99015E+00,-0.99049E+00,-0.99083E+00, + &-0.99117E+00,-0.99151E+00,-0.99185E+00,-0.99218E+00,-0.99252E+00, + &-0.99285E+00,-0.99319E+00,-0.99352E+00,-0.99385E+00,-0.99419E+00, + &-0.99452E+00,-0.99485E+00,-0.99518E+00,-0.99551E+00,-0.99584E+00, + &-0.99616E+00,-0.99649E+00,-0.99682E+00,-0.99714E+00,-0.99747E+00, + &-0.99779E+00,-0.99812E+00,-0.99844E+00,-0.99876E+00,-0.99908E+00, + &-0.99940E+00,-0.99972E+00,-0.10000E+01,-0.10004E+01,-0.10007E+01, + &-0.10010E+01,-0.10013E+01,-0.10016E+01,-0.10019E+01,-0.10023E+01, + &-0.10026E+01,-0.10029E+01,-0.10032E+01,-0.10035E+01,-0.10038E+01/ + + DATA (BNC02M (I),I=501,600)/ + &-0.10041E+01,-0.10044E+01,-0.10048E+01,-0.10051E+01,-0.10054E+01, + &-0.10057E+01,-0.10060E+01,-0.10063E+01,-0.10066E+01,-0.10069E+01, + &-0.10072E+01,-0.10075E+01,-0.10078E+01,-0.10081E+01,-0.10084E+01, + &-0.10087E+01,-0.10090E+01,-0.10093E+01,-0.10096E+01,-0.10099E+01, + &-0.10102E+01,-0.10105E+01,-0.10108E+01,-0.10111E+01,-0.10114E+01, + &-0.10117E+01,-0.10120E+01,-0.10123E+01,-0.10126E+01,-0.10129E+01, + &-0.10132E+01,-0.10135E+01,-0.10138E+01,-0.10141E+01,-0.10144E+01, + &-0.10146E+01,-0.10149E+01,-0.10152E+01,-0.10155E+01,-0.10158E+01, + &-0.10161E+01,-0.10164E+01,-0.10167E+01,-0.10169E+01,-0.10172E+01, + &-0.10175E+01,-0.10178E+01,-0.10181E+01,-0.10184E+01,-0.10187E+01, + &-0.10189E+01,-0.10192E+01,-0.10195E+01,-0.10198E+01,-0.10201E+01, + &-0.10203E+01,-0.10206E+01,-0.10209E+01,-0.10212E+01,-0.10215E+01, + &-0.10217E+01,-0.10220E+01,-0.10223E+01,-0.10226E+01,-0.10228E+01, + &-0.10231E+01,-0.10234E+01,-0.10237E+01,-0.10239E+01,-0.10242E+01, + &-0.10245E+01,-0.10247E+01,-0.10250E+01,-0.10253E+01,-0.10256E+01, + &-0.10258E+01,-0.10261E+01,-0.10264E+01,-0.10266E+01,-0.10269E+01, + &-0.10272E+01,-0.10274E+01,-0.10277E+01,-0.10280E+01,-0.10282E+01, + &-0.10285E+01,-0.10288E+01,-0.10290E+01,-0.10293E+01,-0.10296E+01, + &-0.10298E+01,-0.10301E+01,-0.10303E+01,-0.10306E+01,-0.10309E+01, + &-0.10311E+01,-0.10314E+01,-0.10316E+01,-0.10319E+01,-0.10329E+01/ + + DATA (BNC02M (I),I=601,700)/ + &-0.10350E+01,-0.10375E+01,-0.10400E+01,-0.10424E+01,-0.10448E+01, + &-0.10471E+01,-0.10495E+01,-0.10517E+01,-0.10540E+01,-0.10562E+01, + &-0.10584E+01,-0.10605E+01,-0.10627E+01,-0.10647E+01,-0.10668E+01, + &-0.10688E+01,-0.10708E+01,-0.10728E+01,-0.10748E+01,-0.10767E+01, + &-0.10786E+01,-0.10805E+01,-0.10823E+01,-0.10841E+01,-0.10860E+01, + &-0.10877E+01,-0.10895E+01,-0.10912E+01,-0.10930E+01,-0.10947E+01, + &-0.10963E+01,-0.10980E+01,-0.10996E+01,-0.11013E+01,-0.11029E+01, + &-0.11044E+01,-0.11060E+01,-0.11076E+01,-0.11091E+01,-0.11106E+01, + &-0.11121E+01,-0.11136E+01,-0.11151E+01,-0.11165E+01,-0.11180E+01, + &-0.11194E+01,-0.11208E+01,-0.11222E+01,-0.11236E+01,-0.11250E+01, + &-0.11263E+01,-0.11277E+01,-0.11290E+01,-0.11303E+01,-0.11316E+01, + &-0.11329E+01,-0.11342E+01,-0.11355E+01,-0.11368E+01,-0.11380E+01, + &-0.11392E+01,-0.11405E+01,-0.11417E+01,-0.11429E+01,-0.11441E+01, + &-0.11453E+01,-0.11464E+01,-0.11476E+01,-0.11488E+01,-0.11499E+01, + &-0.11510E+01,-0.11522E+01,-0.11533E+01,-0.11544E+01,-0.11555E+01, + &-0.11566E+01,-0.11577E+01,-0.11587E+01,-0.11598E+01,-0.11609E+01, + &-0.11619E+01,-0.11630E+01,-0.11640E+01,-0.11650E+01,-0.11660E+01, + &-0.11670E+01,-0.11680E+01,-0.11690E+01,-0.11700E+01,-0.11710E+01, + &-0.11720E+01,-0.11729E+01,-0.11739E+01,-0.11749E+01,-0.11758E+01, + &-0.11767E+01,-0.11777E+01,-0.11786E+01,-0.11795E+01,-0.11804E+01/ + + DATA (BNC02M(I),I=701,741)/ + &-0.11813E+01,-0.11822E+01,-0.11831E+01,-0.11840E+01,-0.11849E+01, + &-0.11858E+01,-0.11867E+01,-0.11875E+01,-0.11884E+01,-0.11893E+01, + &-0.11901E+01,-0.11909E+01,-0.11918E+01,-0.11926E+01,-0.11934E+01, + &-0.11943E+01,-0.11951E+01,-0.11959E+01,-0.11967E+01,-0.11975E+01, + &-0.11983E+01,-0.11991E+01,-0.11999E+01,-0.12007E+01,-0.12015E+01, + &-0.12022E+01,-0.12030E+01,-0.12038E+01,-0.12045E+01,-0.12053E+01, + &-0.12060E+01,-0.12068E+01,-0.12075E+01,-0.12083E+01,-0.12090E+01, + &-0.12097E+01,-0.12105E+01,-0.12112E+01,-0.12119E+01,-0.12126E+01, + &-0.12133E+01 + & / +C +C *** NaNO3 +C + DATA (BNC03M (I),I= 1,100)/ + &-0.51631E-01,-0.94349E-01,-0.12464E+00,-0.14539E+00,-0.16147E+00, + &-0.17470E+00,-0.18599E+00,-0.19586E+00,-0.20466E+00,-0.21259E+00, + &-0.21982E+00,-0.22648E+00,-0.23265E+00,-0.23839E+00,-0.24378E+00, + &-0.24884E+00,-0.25363E+00,-0.25817E+00,-0.26248E+00,-0.26659E+00, + &-0.27052E+00,-0.27428E+00,-0.27789E+00,-0.28136E+00,-0.28470E+00, + &-0.28792E+00,-0.29103E+00,-0.29403E+00,-0.29694E+00,-0.29976E+00, + &-0.30249E+00,-0.30515E+00,-0.30772E+00,-0.31023E+00,-0.31267E+00, + &-0.31505E+00,-0.31736E+00,-0.31962E+00,-0.32182E+00,-0.32397E+00, + &-0.32607E+00,-0.32812E+00,-0.33013E+00,-0.33209E+00,-0.33401E+00, + &-0.33590E+00,-0.33774E+00,-0.33954E+00,-0.34131E+00,-0.34305E+00, + &-0.34475E+00,-0.34642E+00,-0.34806E+00,-0.34967E+00,-0.35125E+00, + &-0.35281E+00,-0.35434E+00,-0.35584E+00,-0.35732E+00,-0.35877E+00, + &-0.36021E+00,-0.36162E+00,-0.36300E+00,-0.36437E+00,-0.36572E+00, + &-0.36705E+00,-0.36836E+00,-0.36965E+00,-0.37093E+00,-0.37219E+00, + &-0.37343E+00,-0.37466E+00,-0.37588E+00,-0.37707E+00,-0.37826E+00, + &-0.37943E+00,-0.38059E+00,-0.38174E+00,-0.38287E+00,-0.38400E+00, + &-0.38511E+00,-0.38621E+00,-0.38730E+00,-0.38838E+00,-0.38945E+00, + &-0.39051E+00,-0.39157E+00,-0.39261E+00,-0.39364E+00,-0.39467E+00, + &-0.39569E+00,-0.39670E+00,-0.39770E+00,-0.39869E+00,-0.39968E+00, + &-0.40066E+00,-0.40163E+00,-0.40260E+00,-0.40356E+00,-0.40451E+00/ + + DATA (BNC03M (I),I=101,200)/ + &-0.40545E+00,-0.40639E+00,-0.40733E+00,-0.40825E+00,-0.40917E+00, + &-0.41009E+00,-0.41099E+00,-0.41190E+00,-0.41279E+00,-0.41368E+00, + &-0.41457E+00,-0.41544E+00,-0.41632E+00,-0.41718E+00,-0.41804E+00, + &-0.41890E+00,-0.41975E+00,-0.42060E+00,-0.42143E+00,-0.42227E+00, + &-0.42306E+00,-0.42389E+00,-0.42471E+00,-0.42553E+00,-0.42634E+00, + &-0.42714E+00,-0.42794E+00,-0.42874E+00,-0.42953E+00,-0.43031E+00, + &-0.43109E+00,-0.43187E+00,-0.43264E+00,-0.43340E+00,-0.43416E+00, + &-0.43492E+00,-0.43567E+00,-0.43641E+00,-0.43715E+00,-0.43789E+00, + &-0.43862E+00,-0.43935E+00,-0.44007E+00,-0.44079E+00,-0.44151E+00, + &-0.44222E+00,-0.44293E+00,-0.44363E+00,-0.44433E+00,-0.44503E+00, + &-0.44572E+00,-0.44640E+00,-0.44709E+00,-0.44777E+00,-0.44844E+00, + &-0.44912E+00,-0.44978E+00,-0.45045E+00,-0.45111E+00,-0.45177E+00, + &-0.45242E+00,-0.45307E+00,-0.45372E+00,-0.45437E+00,-0.45501E+00, + &-0.45565E+00,-0.45628E+00,-0.45691E+00,-0.45754E+00,-0.45816E+00, + &-0.45879E+00,-0.45940E+00,-0.46002E+00,-0.46063E+00,-0.46124E+00, + &-0.46185E+00,-0.46245E+00,-0.46305E+00,-0.46365E+00,-0.46425E+00, + &-0.46484E+00,-0.46543E+00,-0.46601E+00,-0.46660E+00,-0.46718E+00, + &-0.46776E+00,-0.46833E+00,-0.46891E+00,-0.46948E+00,-0.47005E+00, + &-0.47061E+00,-0.47117E+00,-0.47173E+00,-0.47229E+00,-0.47285E+00, + &-0.47340E+00,-0.47395E+00,-0.47450E+00,-0.47505E+00,-0.47559E+00/ + + DATA (BNC03M (I),I=201,300)/ + &-0.47613E+00,-0.47667E+00,-0.47721E+00,-0.47774E+00,-0.47827E+00, + &-0.47880E+00,-0.47933E+00,-0.47985E+00,-0.48038E+00,-0.48090E+00, + &-0.48142E+00,-0.48193E+00,-0.48245E+00,-0.48296E+00,-0.48347E+00, + &-0.48398E+00,-0.48449E+00,-0.48499E+00,-0.48549E+00,-0.48599E+00, + &-0.48649E+00,-0.48699E+00,-0.48748E+00,-0.48797E+00,-0.48847E+00, + &-0.48895E+00,-0.48944E+00,-0.48993E+00,-0.49041E+00,-0.49089E+00, + &-0.49137E+00,-0.49185E+00,-0.49232E+00,-0.49280E+00,-0.49327E+00, + &-0.49374E+00,-0.49421E+00,-0.49468E+00,-0.49514E+00,-0.49560E+00, + &-0.49607E+00,-0.49653E+00,-0.49699E+00,-0.49744E+00,-0.49790E+00, + &-0.49835E+00,-0.49880E+00,-0.49925E+00,-0.49970E+00,-0.50015E+00, + &-0.50060E+00,-0.50104E+00,-0.50148E+00,-0.50192E+00,-0.50236E+00, + &-0.50280E+00,-0.50324E+00,-0.50367E+00,-0.50411E+00,-0.50454E+00, + &-0.50497E+00,-0.50540E+00,-0.50582E+00,-0.50625E+00,-0.50668E+00, + &-0.50710E+00,-0.50752E+00,-0.50794E+00,-0.50836E+00,-0.50878E+00, + &-0.50919E+00,-0.50961E+00,-0.51002E+00,-0.51043E+00,-0.51085E+00, + &-0.51126E+00,-0.51166E+00,-0.51207E+00,-0.51248E+00,-0.51288E+00, + &-0.51328E+00,-0.51369E+00,-0.51409E+00,-0.51449E+00,-0.51488E+00, + &-0.51528E+00,-0.51568E+00,-0.51607E+00,-0.51646E+00,-0.51686E+00, + &-0.51725E+00,-0.51764E+00,-0.51802E+00,-0.51841E+00,-0.51880E+00, + &-0.51918E+00,-0.51956E+00,-0.51995E+00,-0.52033E+00,-0.52071E+00/ + + DATA (BNC03M (I),I=301,400)/ + &-0.52109E+00,-0.52146E+00,-0.52184E+00,-0.52222E+00,-0.52259E+00, + &-0.52296E+00,-0.52334E+00,-0.52371E+00,-0.52408E+00,-0.52445E+00, + &-0.52482E+00,-0.52518E+00,-0.52555E+00,-0.52591E+00,-0.52628E+00, + &-0.52664E+00,-0.52700E+00,-0.52736E+00,-0.52772E+00,-0.52808E+00, + &-0.52844E+00,-0.52879E+00,-0.52915E+00,-0.52950E+00,-0.52986E+00, + &-0.53021E+00,-0.53056E+00,-0.53091E+00,-0.53126E+00,-0.53161E+00, + &-0.53196E+00,-0.53230E+00,-0.53265E+00,-0.53299E+00,-0.53334E+00, + &-0.53368E+00,-0.53402E+00,-0.53436E+00,-0.53470E+00,-0.53504E+00, + &-0.53538E+00,-0.53572E+00,-0.53605E+00,-0.53639E+00,-0.53672E+00, + &-0.53706E+00,-0.53739E+00,-0.53772E+00,-0.53805E+00,-0.53838E+00, + &-0.53871E+00,-0.53904E+00,-0.53937E+00,-0.53970E+00,-0.54002E+00, + &-0.54035E+00,-0.54067E+00,-0.54100E+00,-0.54132E+00,-0.54164E+00, + &-0.54196E+00,-0.54228E+00,-0.54260E+00,-0.54292E+00,-0.54324E+00, + &-0.54355E+00,-0.54387E+00,-0.54419E+00,-0.54450E+00,-0.54481E+00, + &-0.54513E+00,-0.54544E+00,-0.54575E+00,-0.54606E+00,-0.54637E+00, + &-0.54668E+00,-0.54699E+00,-0.54730E+00,-0.54760E+00,-0.54791E+00, + &-0.54821E+00,-0.54852E+00,-0.54882E+00,-0.54913E+00,-0.54943E+00, + &-0.54973E+00,-0.55003E+00,-0.55033E+00,-0.55063E+00,-0.55093E+00, + &-0.55123E+00,-0.55152E+00,-0.55182E+00,-0.55212E+00,-0.55241E+00, + &-0.55271E+00,-0.55300E+00,-0.55329E+00,-0.55359E+00,-0.55388E+00/ + + DATA (BNC03M (I),I=401,500)/ + &-0.55417E+00,-0.55446E+00,-0.55475E+00,-0.55504E+00,-0.55533E+00, + &-0.55561E+00,-0.55590E+00,-0.55619E+00,-0.55647E+00,-0.55676E+00, + &-0.55704E+00,-0.55733E+00,-0.55761E+00,-0.55789E+00,-0.55817E+00, + &-0.55845E+00,-0.55874E+00,-0.55902E+00,-0.55929E+00,-0.55957E+00, + &-0.55985E+00,-0.56013E+00,-0.56041E+00,-0.56068E+00,-0.56096E+00, + &-0.56123E+00,-0.56151E+00,-0.56178E+00,-0.56205E+00,-0.56233E+00, + &-0.56260E+00,-0.56287E+00,-0.56314E+00,-0.56341E+00,-0.56368E+00, + &-0.56395E+00,-0.56422E+00,-0.56449E+00,-0.56475E+00,-0.56502E+00, + &-0.56529E+00,-0.56555E+00,-0.56582E+00,-0.56608E+00,-0.56634E+00, + &-0.56661E+00,-0.56687E+00,-0.56713E+00,-0.56739E+00,-0.56766E+00, + &-0.56792E+00,-0.56818E+00,-0.56843E+00,-0.56869E+00,-0.56895E+00, + &-0.56921E+00,-0.56947E+00,-0.56972E+00,-0.56998E+00,-0.57024E+00, + &-0.57049E+00,-0.57075E+00,-0.57100E+00,-0.57125E+00,-0.57151E+00, + &-0.57176E+00,-0.57201E+00,-0.57226E+00,-0.57251E+00,-0.57276E+00, + &-0.57301E+00,-0.57326E+00,-0.57351E+00,-0.57376E+00,-0.57401E+00, + &-0.57425E+00,-0.57450E+00,-0.57475E+00,-0.57499E+00,-0.57524E+00, + &-0.57548E+00,-0.57573E+00,-0.57597E+00,-0.57622E+00,-0.57646E+00, + &-0.57670E+00,-0.57694E+00,-0.57719E+00,-0.57743E+00,-0.57767E+00, + &-0.57791E+00,-0.57815E+00,-0.57839E+00,-0.57862E+00,-0.57886E+00, + &-0.57910E+00,-0.57934E+00,-0.57958E+00,-0.57981E+00,-0.58005E+00/ + + DATA (BNC03M (I),I=501,600)/ + &-0.58028E+00,-0.58052E+00,-0.58075E+00,-0.58099E+00,-0.58122E+00, + &-0.58145E+00,-0.58169E+00,-0.58192E+00,-0.58215E+00,-0.58238E+00, + &-0.58261E+00,-0.58284E+00,-0.58307E+00,-0.58330E+00,-0.58353E+00, + &-0.58376E+00,-0.58399E+00,-0.58422E+00,-0.58445E+00,-0.58467E+00, + &-0.58490E+00,-0.58513E+00,-0.58535E+00,-0.58558E+00,-0.58580E+00, + &-0.58603E+00,-0.58625E+00,-0.58648E+00,-0.58670E+00,-0.58692E+00, + &-0.58714E+00,-0.58737E+00,-0.58759E+00,-0.58781E+00,-0.58803E+00, + &-0.58825E+00,-0.58847E+00,-0.58869E+00,-0.58891E+00,-0.58913E+00, + &-0.58935E+00,-0.58957E+00,-0.58978E+00,-0.59000E+00,-0.59022E+00, + &-0.59044E+00,-0.59065E+00,-0.59087E+00,-0.59108E+00,-0.59130E+00, + &-0.59151E+00,-0.59173E+00,-0.59194E+00,-0.59215E+00,-0.59237E+00, + &-0.59258E+00,-0.59279E+00,-0.59300E+00,-0.59322E+00,-0.59343E+00, + &-0.59364E+00,-0.59385E+00,-0.59406E+00,-0.59427E+00,-0.59448E+00, + &-0.59469E+00,-0.59490E+00,-0.59511E+00,-0.59531E+00,-0.59552E+00, + &-0.59573E+00,-0.59594E+00,-0.59614E+00,-0.59635E+00,-0.59655E+00, + &-0.59676E+00,-0.59696E+00,-0.59717E+00,-0.59737E+00,-0.59758E+00, + &-0.59778E+00,-0.59799E+00,-0.59819E+00,-0.59839E+00,-0.59859E+00, + &-0.59880E+00,-0.59900E+00,-0.59920E+00,-0.59940E+00,-0.59960E+00, + &-0.59980E+00,-0.60000E+00,-0.60020E+00,-0.60040E+00,-0.60060E+00, + &-0.60080E+00,-0.60100E+00,-0.60119E+00,-0.60139E+00,-0.60213E+00/ + + DATA (BNC03M (I),I=601,700)/ + &-0.60374E+00,-0.60566E+00,-0.60755E+00,-0.60942E+00,-0.61125E+00, + &-0.61305E+00,-0.61483E+00,-0.61658E+00,-0.61831E+00,-0.62001E+00, + &-0.62169E+00,-0.62334E+00,-0.62497E+00,-0.62658E+00,-0.62816E+00, + &-0.62973E+00,-0.63127E+00,-0.63279E+00,-0.63429E+00,-0.63578E+00, + &-0.63724E+00,-0.63869E+00,-0.64012E+00,-0.64153E+00,-0.64292E+00, + &-0.64430E+00,-0.64566E+00,-0.64700E+00,-0.64833E+00,-0.64964E+00, + &-0.65094E+00,-0.65222E+00,-0.65349E+00,-0.65475E+00,-0.65599E+00, + &-0.65721E+00,-0.65843E+00,-0.65963E+00,-0.66082E+00,-0.66199E+00, + &-0.66315E+00,-0.66431E+00,-0.66544E+00,-0.66657E+00,-0.66769E+00, + &-0.66879E+00,-0.66989E+00,-0.67097E+00,-0.67204E+00,-0.67310E+00, + &-0.67415E+00,-0.67520E+00,-0.67623E+00,-0.67725E+00,-0.67826E+00, + &-0.67927E+00,-0.68026E+00,-0.68124E+00,-0.68222E+00,-0.68319E+00, + &-0.68415E+00,-0.68510E+00,-0.68604E+00,-0.68697E+00,-0.68790E+00, + &-0.68881E+00,-0.68972E+00,-0.69062E+00,-0.69152E+00,-0.69241E+00, + &-0.69329E+00,-0.69416E+00,-0.69502E+00,-0.69588E+00,-0.69673E+00, + &-0.69758E+00,-0.69841E+00,-0.69924E+00,-0.70007E+00,-0.70089E+00, + &-0.70170E+00,-0.70250E+00,-0.70330E+00,-0.70410E+00,-0.70488E+00, + &-0.70566E+00,-0.70644E+00,-0.70721E+00,-0.70797E+00,-0.70873E+00, + &-0.70948E+00,-0.71023E+00,-0.71097E+00,-0.71171E+00,-0.71244E+00, + &-0.71317E+00,-0.71389E+00,-0.71460E+00,-0.71531E+00,-0.71602E+00/ + + DATA (BNC03M(I),I=701,741)/ + &-0.71672E+00,-0.71742E+00,-0.71811E+00,-0.71880E+00,-0.71948E+00, + &-0.72016E+00,-0.72083E+00,-0.72150E+00,-0.72216E+00,-0.72282E+00, + &-0.72348E+00,-0.72413E+00,-0.72478E+00,-0.72542E+00,-0.72606E+00, + &-0.72670E+00,-0.72733E+00,-0.72795E+00,-0.72858E+00,-0.72920E+00, + &-0.72981E+00,-0.73042E+00,-0.73103E+00,-0.73163E+00,-0.73223E+00, + &-0.73283E+00,-0.73342E+00,-0.73401E+00,-0.73460E+00,-0.73518E+00, + &-0.73576E+00,-0.73634E+00,-0.73691E+00,-0.73748E+00,-0.73805E+00, + &-0.73861E+00,-0.73917E+00,-0.73972E+00,-0.74028E+00,-0.74083E+00, + &-0.74137E+00 + & / +C +C *** (NH4)2SO4 +C + DATA (BNC04M (I),I= 1,100)/ + &-0.10306E+00,-0.18795E+00,-0.24786E+00,-0.28872E+00,-0.32027E+00, + &-0.34614E+00,-0.36814E+00,-0.38733E+00,-0.40435E+00,-0.41967E+00, + &-0.43360E+00,-0.44638E+00,-0.45819E+00,-0.46917E+00,-0.47943E+00, + &-0.48906E+00,-0.49813E+00,-0.50671E+00,-0.51485E+00,-0.52259E+00, + &-0.52997E+00,-0.53702E+00,-0.54377E+00,-0.55025E+00,-0.55647E+00, + &-0.56246E+00,-0.56823E+00,-0.57380E+00,-0.57918E+00,-0.58438E+00, + &-0.58942E+00,-0.59430E+00,-0.59904E+00,-0.60363E+00,-0.60810E+00, + &-0.61245E+00,-0.61668E+00,-0.62079E+00,-0.62480E+00,-0.62872E+00, + &-0.63253E+00,-0.63626E+00,-0.63989E+00,-0.64345E+00,-0.64692E+00, + &-0.65032E+00,-0.65365E+00,-0.65690E+00,-0.66009E+00,-0.66321E+00, + &-0.66627E+00,-0.66927E+00,-0.67221E+00,-0.67510E+00,-0.67793E+00, + &-0.68071E+00,-0.68344E+00,-0.68613E+00,-0.68876E+00,-0.69136E+00, + &-0.69391E+00,-0.69641E+00,-0.69888E+00,-0.70131E+00,-0.70370E+00, + &-0.70606E+00,-0.70838E+00,-0.71067E+00,-0.71292E+00,-0.71514E+00, + &-0.71734E+00,-0.71950E+00,-0.72164E+00,-0.72374E+00,-0.72582E+00, + &-0.72788E+00,-0.72991E+00,-0.73191E+00,-0.73390E+00,-0.73586E+00, + &-0.73780E+00,-0.73971E+00,-0.74161E+00,-0.74349E+00,-0.74534E+00, + &-0.74718E+00,-0.74900E+00,-0.75080E+00,-0.75259E+00,-0.75436E+00, + &-0.75611E+00,-0.75784E+00,-0.75956E+00,-0.76127E+00,-0.76296E+00, + &-0.76463E+00,-0.76629E+00,-0.76794E+00,-0.76957E+00,-0.77119E+00/ + + DATA (BNC04M (I),I=101,200)/ + &-0.77280E+00,-0.77439E+00,-0.77597E+00,-0.77754E+00,-0.77910E+00, + &-0.78064E+00,-0.78218E+00,-0.78370E+00,-0.78520E+00,-0.78670E+00, + &-0.78819E+00,-0.78966E+00,-0.79113E+00,-0.79258E+00,-0.79402E+00, + &-0.79545E+00,-0.79687E+00,-0.79828E+00,-0.79968E+00,-0.80107E+00, + &-0.80241E+00,-0.80378E+00,-0.80515E+00,-0.80650E+00,-0.80785E+00, + &-0.80918E+00,-0.81051E+00,-0.81183E+00,-0.81313E+00,-0.81443E+00, + &-0.81572E+00,-0.81700E+00,-0.81827E+00,-0.81953E+00,-0.82078E+00, + &-0.82203E+00,-0.82327E+00,-0.82449E+00,-0.82571E+00,-0.82692E+00, + &-0.82813E+00,-0.82932E+00,-0.83051E+00,-0.83169E+00,-0.83287E+00, + &-0.83403E+00,-0.83519E+00,-0.83634E+00,-0.83748E+00,-0.83862E+00, + &-0.83975E+00,-0.84087E+00,-0.84199E+00,-0.84310E+00,-0.84420E+00, + &-0.84530E+00,-0.84639E+00,-0.84747E+00,-0.84855E+00,-0.84962E+00, + &-0.85068E+00,-0.85174E+00,-0.85280E+00,-0.85384E+00,-0.85488E+00, + &-0.85592E+00,-0.85695E+00,-0.85797E+00,-0.85899E+00,-0.86000E+00, + &-0.86101E+00,-0.86201E+00,-0.86301E+00,-0.86400E+00,-0.86498E+00, + &-0.86596E+00,-0.86694E+00,-0.86791E+00,-0.86887E+00,-0.86983E+00, + &-0.87079E+00,-0.87174E+00,-0.87268E+00,-0.87362E+00,-0.87456E+00, + &-0.87549E+00,-0.87642E+00,-0.87734E+00,-0.87826E+00,-0.87917E+00, + &-0.88008E+00,-0.88098E+00,-0.88188E+00,-0.88278E+00,-0.88367E+00, + &-0.88456E+00,-0.88544E+00,-0.88632E+00,-0.88719E+00,-0.88806E+00/ + + DATA (BNC04M (I),I=201,300)/ + &-0.88893E+00,-0.88979E+00,-0.89065E+00,-0.89151E+00,-0.89236E+00, + &-0.89320E+00,-0.89405E+00,-0.89489E+00,-0.89572E+00,-0.89655E+00, + &-0.89738E+00,-0.89821E+00,-0.89903E+00,-0.89984E+00,-0.90066E+00, + &-0.90147E+00,-0.90227E+00,-0.90308E+00,-0.90388E+00,-0.90467E+00, + &-0.90547E+00,-0.90626E+00,-0.90704E+00,-0.90783E+00,-0.90861E+00, + &-0.90938E+00,-0.91016E+00,-0.91093E+00,-0.91169E+00,-0.91246E+00, + &-0.91322E+00,-0.91398E+00,-0.91473E+00,-0.91548E+00,-0.91623E+00, + &-0.91698E+00,-0.91772E+00,-0.91846E+00,-0.91920E+00,-0.91993E+00, + &-0.92066E+00,-0.92139E+00,-0.92211E+00,-0.92284E+00,-0.92356E+00, + &-0.92427E+00,-0.92499E+00,-0.92570E+00,-0.92641E+00,-0.92712E+00, + &-0.92782E+00,-0.92852E+00,-0.92922E+00,-0.92991E+00,-0.93061E+00, + &-0.93130E+00,-0.93199E+00,-0.93267E+00,-0.93336E+00,-0.93404E+00, + &-0.93471E+00,-0.93539E+00,-0.93606E+00,-0.93674E+00,-0.93740E+00, + &-0.93807E+00,-0.93873E+00,-0.93940E+00,-0.94005E+00,-0.94071E+00, + &-0.94137E+00,-0.94202E+00,-0.94267E+00,-0.94332E+00,-0.94396E+00, + &-0.94460E+00,-0.94525E+00,-0.94589E+00,-0.94652E+00,-0.94716E+00, + &-0.94779E+00,-0.94842E+00,-0.94905E+00,-0.94967E+00,-0.95030E+00, + &-0.95092E+00,-0.95154E+00,-0.95216E+00,-0.95277E+00,-0.95339E+00, + &-0.95400E+00,-0.95461E+00,-0.95522E+00,-0.95582E+00,-0.95643E+00, + &-0.95703E+00,-0.95763E+00,-0.95823E+00,-0.95882E+00,-0.95942E+00/ + + DATA (BNC04M (I),I=301,400)/ + &-0.96001E+00,-0.96060E+00,-0.96119E+00,-0.96178E+00,-0.96236E+00, + &-0.96294E+00,-0.96353E+00,-0.96411E+00,-0.96468E+00,-0.96526E+00, + &-0.96583E+00,-0.96641E+00,-0.96698E+00,-0.96755E+00,-0.96811E+00, + &-0.96868E+00,-0.96924E+00,-0.96981E+00,-0.97037E+00,-0.97092E+00, + &-0.97148E+00,-0.97204E+00,-0.97259E+00,-0.97314E+00,-0.97369E+00, + &-0.97424E+00,-0.97479E+00,-0.97534E+00,-0.97588E+00,-0.97642E+00, + &-0.97696E+00,-0.97750E+00,-0.97804E+00,-0.97858E+00,-0.97911E+00, + &-0.97965E+00,-0.98018E+00,-0.98071E+00,-0.98124E+00,-0.98176E+00, + &-0.98229E+00,-0.98281E+00,-0.98334E+00,-0.98386E+00,-0.98438E+00, + &-0.98490E+00,-0.98541E+00,-0.98593E+00,-0.98644E+00,-0.98696E+00, + &-0.98747E+00,-0.98798E+00,-0.98849E+00,-0.98899E+00,-0.98950E+00, + &-0.99000E+00,-0.99051E+00,-0.99101E+00,-0.99151E+00,-0.99201E+00, + &-0.99251E+00,-0.99300E+00,-0.99350E+00,-0.99399E+00,-0.99448E+00, + &-0.99497E+00,-0.99546E+00,-0.99595E+00,-0.99644E+00,-0.99693E+00, + &-0.99741E+00,-0.99789E+00,-0.99838E+00,-0.99886E+00,-0.99934E+00, + &-0.99982E+00,-0.10003E+01,-0.10008E+01,-0.10012E+01,-0.10017E+01, + &-0.10022E+01,-0.10027E+01,-0.10031E+01,-0.10036E+01,-0.10041E+01, + &-0.10045E+01,-0.10050E+01,-0.10055E+01,-0.10059E+01,-0.10064E+01, + &-0.10068E+01,-0.10073E+01,-0.10078E+01,-0.10082E+01,-0.10087E+01, + &-0.10091E+01,-0.10096E+01,-0.10100E+01,-0.10105E+01,-0.10109E+01/ + + DATA (BNC04M (I),I=401,500)/ + &-0.10114E+01,-0.10118E+01,-0.10123E+01,-0.10127E+01,-0.10132E+01, + &-0.10136E+01,-0.10141E+01,-0.10145E+01,-0.10149E+01,-0.10154E+01, + &-0.10158E+01,-0.10163E+01,-0.10167E+01,-0.10171E+01,-0.10176E+01, + &-0.10180E+01,-0.10184E+01,-0.10189E+01,-0.10193E+01,-0.10197E+01, + &-0.10202E+01,-0.10206E+01,-0.10210E+01,-0.10214E+01,-0.10219E+01, + &-0.10223E+01,-0.10227E+01,-0.10231E+01,-0.10236E+01,-0.10240E+01, + &-0.10244E+01,-0.10248E+01,-0.10252E+01,-0.10256E+01,-0.10261E+01, + &-0.10265E+01,-0.10269E+01,-0.10273E+01,-0.10277E+01,-0.10281E+01, + &-0.10285E+01,-0.10289E+01,-0.10293E+01,-0.10298E+01,-0.10302E+01, + &-0.10306E+01,-0.10310E+01,-0.10314E+01,-0.10318E+01,-0.10322E+01, + &-0.10326E+01,-0.10330E+01,-0.10334E+01,-0.10338E+01,-0.10342E+01, + &-0.10346E+01,-0.10350E+01,-0.10354E+01,-0.10357E+01,-0.10361E+01, + &-0.10365E+01,-0.10369E+01,-0.10373E+01,-0.10377E+01,-0.10381E+01, + &-0.10385E+01,-0.10389E+01,-0.10393E+01,-0.10396E+01,-0.10400E+01, + &-0.10404E+01,-0.10408E+01,-0.10412E+01,-0.10416E+01,-0.10419E+01, + &-0.10423E+01,-0.10427E+01,-0.10431E+01,-0.10435E+01,-0.10438E+01, + &-0.10442E+01,-0.10446E+01,-0.10450E+01,-0.10453E+01,-0.10457E+01, + &-0.10461E+01,-0.10464E+01,-0.10468E+01,-0.10472E+01,-0.10476E+01, + &-0.10479E+01,-0.10483E+01,-0.10487E+01,-0.10490E+01,-0.10494E+01, + &-0.10498E+01,-0.10501E+01,-0.10505E+01,-0.10508E+01,-0.10512E+01/ + + DATA (BNC04M (I),I=501,600)/ + &-0.10516E+01,-0.10519E+01,-0.10523E+01,-0.10526E+01,-0.10530E+01, + &-0.10534E+01,-0.10537E+01,-0.10541E+01,-0.10544E+01,-0.10548E+01, + &-0.10551E+01,-0.10555E+01,-0.10558E+01,-0.10562E+01,-0.10565E+01, + &-0.10569E+01,-0.10572E+01,-0.10576E+01,-0.10579E+01,-0.10583E+01, + &-0.10586E+01,-0.10590E+01,-0.10593E+01,-0.10597E+01,-0.10600E+01, + &-0.10604E+01,-0.10607E+01,-0.10611E+01,-0.10614E+01,-0.10617E+01, + &-0.10621E+01,-0.10624E+01,-0.10628E+01,-0.10631E+01,-0.10634E+01, + &-0.10638E+01,-0.10641E+01,-0.10644E+01,-0.10648E+01,-0.10651E+01, + &-0.10655E+01,-0.10658E+01,-0.10661E+01,-0.10665E+01,-0.10668E+01, + &-0.10671E+01,-0.10674E+01,-0.10678E+01,-0.10681E+01,-0.10684E+01, + &-0.10688E+01,-0.10691E+01,-0.10694E+01,-0.10697E+01,-0.10701E+01, + &-0.10704E+01,-0.10707E+01,-0.10710E+01,-0.10714E+01,-0.10717E+01, + &-0.10720E+01,-0.10723E+01,-0.10727E+01,-0.10730E+01,-0.10733E+01, + &-0.10736E+01,-0.10739E+01,-0.10743E+01,-0.10746E+01,-0.10749E+01, + &-0.10752E+01,-0.10755E+01,-0.10758E+01,-0.10762E+01,-0.10765E+01, + &-0.10768E+01,-0.10771E+01,-0.10774E+01,-0.10777E+01,-0.10780E+01, + &-0.10783E+01,-0.10787E+01,-0.10790E+01,-0.10793E+01,-0.10796E+01, + &-0.10799E+01,-0.10802E+01,-0.10805E+01,-0.10808E+01,-0.10811E+01, + &-0.10814E+01,-0.10817E+01,-0.10820E+01,-0.10823E+01,-0.10827E+01, + &-0.10830E+01,-0.10833E+01,-0.10836E+01,-0.10839E+01,-0.10850E+01/ + + DATA (BNC04M (I),I=601,700)/ + &-0.10874E+01,-0.10904E+01,-0.10933E+01,-0.10961E+01,-0.10989E+01, + &-0.11017E+01,-0.11044E+01,-0.11070E+01,-0.11097E+01,-0.11123E+01, + &-0.11148E+01,-0.11173E+01,-0.11198E+01,-0.11223E+01,-0.11247E+01, + &-0.11271E+01,-0.11294E+01,-0.11317E+01,-0.11340E+01,-0.11363E+01, + &-0.11385E+01,-0.11407E+01,-0.11429E+01,-0.11450E+01,-0.11471E+01, + &-0.11492E+01,-0.11513E+01,-0.11534E+01,-0.11554E+01,-0.11574E+01, + &-0.11593E+01,-0.11613E+01,-0.11632E+01,-0.11651E+01,-0.11670E+01, + &-0.11689E+01,-0.11707E+01,-0.11726E+01,-0.11744E+01,-0.11762E+01, + &-0.11779E+01,-0.11797E+01,-0.11814E+01,-0.11831E+01,-0.11848E+01, + &-0.11865E+01,-0.11882E+01,-0.11898E+01,-0.11915E+01,-0.11931E+01, + &-0.11947E+01,-0.11963E+01,-0.11978E+01,-0.11994E+01,-0.12009E+01, + &-0.12025E+01,-0.12040E+01,-0.12055E+01,-0.12070E+01,-0.12084E+01, + &-0.12099E+01,-0.12114E+01,-0.12128E+01,-0.12142E+01,-0.12156E+01, + &-0.12170E+01,-0.12184E+01,-0.12198E+01,-0.12212E+01,-0.12225E+01, + &-0.12238E+01,-0.12252E+01,-0.12265E+01,-0.12278E+01,-0.12291E+01, + &-0.12304E+01,-0.12317E+01,-0.12329E+01,-0.12342E+01,-0.12355E+01, + &-0.12367E+01,-0.12379E+01,-0.12391E+01,-0.12404E+01,-0.12416E+01, + &-0.12428E+01,-0.12439E+01,-0.12451E+01,-0.12463E+01,-0.12474E+01, + &-0.12486E+01,-0.12497E+01,-0.12509E+01,-0.12520E+01,-0.12531E+01, + &-0.12542E+01,-0.12553E+01,-0.12564E+01,-0.12575E+01,-0.12586E+01/ + + DATA (BNC04M(I),I=701,741)/ + &-0.12597E+01,-0.12607E+01,-0.12618E+01,-0.12629E+01,-0.12639E+01, + &-0.12649E+01,-0.12660E+01,-0.12670E+01,-0.12680E+01,-0.12690E+01, + &-0.12700E+01,-0.12710E+01,-0.12720E+01,-0.12730E+01,-0.12740E+01, + &-0.12750E+01,-0.12760E+01,-0.12769E+01,-0.12779E+01,-0.12788E+01, + &-0.12798E+01,-0.12807E+01,-0.12816E+01,-0.12826E+01,-0.12835E+01, + &-0.12844E+01,-0.12853E+01,-0.12862E+01,-0.12871E+01,-0.12880E+01, + &-0.12889E+01,-0.12898E+01,-0.12907E+01,-0.12916E+01,-0.12924E+01, + &-0.12933E+01,-0.12942E+01,-0.12950E+01,-0.12959E+01,-0.12967E+01, + &-0.12976E+01 + & / +C +C *** NH4NO3 +C + DATA (BNC05M (I),I= 1,100)/ + &-0.52199E-01,-0.96472E-01,-0.12869E+00,-0.15126E+00,-0.16910E+00, + &-0.18404E+00,-0.19701E+00,-0.20852E+00,-0.21891E+00,-0.22842E+00, + &-0.23721E+00,-0.24540E+00,-0.25307E+00,-0.26031E+00,-0.26716E+00, + &-0.27368E+00,-0.27990E+00,-0.28586E+00,-0.29157E+00,-0.29707E+00, + &-0.30237E+00,-0.30748E+00,-0.31243E+00,-0.31723E+00,-0.32188E+00, + &-0.32639E+00,-0.33078E+00,-0.33506E+00,-0.33922E+00,-0.34328E+00, + &-0.34724E+00,-0.35110E+00,-0.35488E+00,-0.35857E+00,-0.36218E+00, + &-0.36571E+00,-0.36917E+00,-0.37256E+00,-0.37588E+00,-0.37914E+00, + &-0.38233E+00,-0.38547E+00,-0.38854E+00,-0.39156E+00,-0.39452E+00, + &-0.39743E+00,-0.40030E+00,-0.40311E+00,-0.40587E+00,-0.40860E+00, + &-0.41127E+00,-0.41391E+00,-0.41650E+00,-0.41905E+00,-0.42157E+00, + &-0.42404E+00,-0.42649E+00,-0.42890E+00,-0.43127E+00,-0.43361E+00, + &-0.43593E+00,-0.43821E+00,-0.44046E+00,-0.44269E+00,-0.44489E+00, + &-0.44707E+00,-0.44922E+00,-0.45135E+00,-0.45345E+00,-0.45554E+00, + &-0.45760E+00,-0.45964E+00,-0.46167E+00,-0.46368E+00,-0.46567E+00, + &-0.46764E+00,-0.46960E+00,-0.47154E+00,-0.47347E+00,-0.47539E+00, + &-0.47729E+00,-0.47918E+00,-0.48106E+00,-0.48293E+00,-0.48478E+00, + &-0.48663E+00,-0.48846E+00,-0.49029E+00,-0.49211E+00,-0.49391E+00, + &-0.49571E+00,-0.49750E+00,-0.49928E+00,-0.50105E+00,-0.50282E+00, + &-0.50458E+00,-0.50633E+00,-0.50807E+00,-0.50980E+00,-0.51153E+00/ + + DATA (BNC05M (I),I=101,200)/ + &-0.51325E+00,-0.51496E+00,-0.51667E+00,-0.51837E+00,-0.52006E+00, + &-0.52174E+00,-0.52342E+00,-0.52508E+00,-0.52675E+00,-0.52840E+00, + &-0.53005E+00,-0.53169E+00,-0.53332E+00,-0.53494E+00,-0.53656E+00, + &-0.53817E+00,-0.53977E+00,-0.54137E+00,-0.54295E+00,-0.54453E+00, + &-0.54599E+00,-0.54757E+00,-0.54914E+00,-0.55070E+00,-0.55225E+00, + &-0.55379E+00,-0.55532E+00,-0.55685E+00,-0.55836E+00,-0.55987E+00, + &-0.56137E+00,-0.56286E+00,-0.56435E+00,-0.56582E+00,-0.56729E+00, + &-0.56875E+00,-0.57020E+00,-0.57165E+00,-0.57308E+00,-0.57451E+00, + &-0.57594E+00,-0.57735E+00,-0.57876E+00,-0.58016E+00,-0.58156E+00, + &-0.58294E+00,-0.58432E+00,-0.58570E+00,-0.58706E+00,-0.58842E+00, + &-0.58977E+00,-0.59112E+00,-0.59246E+00,-0.59379E+00,-0.59512E+00, + &-0.59644E+00,-0.59775E+00,-0.59906E+00,-0.60036E+00,-0.60166E+00, + &-0.60295E+00,-0.60423E+00,-0.60551E+00,-0.60678E+00,-0.60805E+00, + &-0.60931E+00,-0.61056E+00,-0.61181E+00,-0.61305E+00,-0.61429E+00, + &-0.61552E+00,-0.61675E+00,-0.61797E+00,-0.61918E+00,-0.62039E+00, + &-0.62160E+00,-0.62280E+00,-0.62399E+00,-0.62518E+00,-0.62636E+00, + &-0.62754E+00,-0.62872E+00,-0.62988E+00,-0.63105E+00,-0.63221E+00, + &-0.63336E+00,-0.63451E+00,-0.63565E+00,-0.63679E+00,-0.63792E+00, + &-0.63905E+00,-0.64018E+00,-0.64130E+00,-0.64241E+00,-0.64352E+00, + &-0.64463E+00,-0.64573E+00,-0.64683E+00,-0.64792E+00,-0.64901E+00/ + + DATA (BNC05M (I),I=201,300)/ + &-0.65009E+00,-0.65117E+00,-0.65225E+00,-0.65332E+00,-0.65438E+00, + &-0.65545E+00,-0.65650E+00,-0.65756E+00,-0.65861E+00,-0.65965E+00, + &-0.66069E+00,-0.66173E+00,-0.66276E+00,-0.66379E+00,-0.66482E+00, + &-0.66584E+00,-0.66686E+00,-0.66787E+00,-0.66888E+00,-0.66989E+00, + &-0.67089E+00,-0.67189E+00,-0.67288E+00,-0.67387E+00,-0.67486E+00, + &-0.67584E+00,-0.67682E+00,-0.67780E+00,-0.67877E+00,-0.67974E+00, + &-0.68070E+00,-0.68166E+00,-0.68262E+00,-0.68358E+00,-0.68453E+00, + &-0.68548E+00,-0.68642E+00,-0.68736E+00,-0.68830E+00,-0.68923E+00, + &-0.69016E+00,-0.69109E+00,-0.69201E+00,-0.69293E+00,-0.69385E+00, + &-0.69476E+00,-0.69567E+00,-0.69658E+00,-0.69749E+00,-0.69839E+00, + &-0.69928E+00,-0.70018E+00,-0.70107E+00,-0.70196E+00,-0.70284E+00, + &-0.70373E+00,-0.70461E+00,-0.70548E+00,-0.70636E+00,-0.70723E+00, + &-0.70809E+00,-0.70896E+00,-0.70982E+00,-0.71068E+00,-0.71153E+00, + &-0.71238E+00,-0.71323E+00,-0.71408E+00,-0.71492E+00,-0.71577E+00, + &-0.71660E+00,-0.71744E+00,-0.71827E+00,-0.71910E+00,-0.71993E+00, + &-0.72075E+00,-0.72158E+00,-0.72239E+00,-0.72321E+00,-0.72402E+00, + &-0.72484E+00,-0.72564E+00,-0.72645E+00,-0.72725E+00,-0.72805E+00, + &-0.72885E+00,-0.72965E+00,-0.73044E+00,-0.73123E+00,-0.73202E+00, + &-0.73280E+00,-0.73359E+00,-0.73437E+00,-0.73514E+00,-0.73592E+00, + &-0.73669E+00,-0.73746E+00,-0.73823E+00,-0.73899E+00,-0.73976E+00/ + + DATA (BNC05M (I),I=301,400)/ + &-0.74052E+00,-0.74128E+00,-0.74203E+00,-0.74279E+00,-0.74354E+00, + &-0.74429E+00,-0.74503E+00,-0.74578E+00,-0.74652E+00,-0.74726E+00, + &-0.74800E+00,-0.74873E+00,-0.74946E+00,-0.75019E+00,-0.75092E+00, + &-0.75165E+00,-0.75237E+00,-0.75309E+00,-0.75381E+00,-0.75453E+00, + &-0.75525E+00,-0.75596E+00,-0.75667E+00,-0.75738E+00,-0.75809E+00, + &-0.75879E+00,-0.75949E+00,-0.76019E+00,-0.76089E+00,-0.76159E+00, + &-0.76228E+00,-0.76297E+00,-0.76366E+00,-0.76435E+00,-0.76504E+00, + &-0.76572E+00,-0.76641E+00,-0.76709E+00,-0.76776E+00,-0.76844E+00, + &-0.76911E+00,-0.76979E+00,-0.77046E+00,-0.77112E+00,-0.77179E+00, + &-0.77246E+00,-0.77312E+00,-0.77378E+00,-0.77444E+00,-0.77509E+00, + &-0.77575E+00,-0.77640E+00,-0.77705E+00,-0.77770E+00,-0.77835E+00, + &-0.77900E+00,-0.77964E+00,-0.78028E+00,-0.78092E+00,-0.78156E+00, + &-0.78220E+00,-0.78283E+00,-0.78347E+00,-0.78410E+00,-0.78473E+00, + &-0.78536E+00,-0.78598E+00,-0.78661E+00,-0.78723E+00,-0.78785E+00, + &-0.78847E+00,-0.78909E+00,-0.78970E+00,-0.79032E+00,-0.79093E+00, + &-0.79154E+00,-0.79215E+00,-0.79276E+00,-0.79336E+00,-0.79397E+00, + &-0.79457E+00,-0.79517E+00,-0.79577E+00,-0.79637E+00,-0.79696E+00, + &-0.79756E+00,-0.79815E+00,-0.79874E+00,-0.79933E+00,-0.79992E+00, + &-0.80051E+00,-0.80109E+00,-0.80168E+00,-0.80226E+00,-0.80284E+00, + &-0.80342E+00,-0.80399E+00,-0.80457E+00,-0.80514E+00,-0.80572E+00/ + + DATA (BNC05M (I),I=401,500)/ + &-0.80629E+00,-0.80686E+00,-0.80743E+00,-0.80799E+00,-0.80856E+00, + &-0.80912E+00,-0.80968E+00,-0.81025E+00,-0.81081E+00,-0.81136E+00, + &-0.81192E+00,-0.81248E+00,-0.81303E+00,-0.81358E+00,-0.81413E+00, + &-0.81468E+00,-0.81523E+00,-0.81578E+00,-0.81632E+00,-0.81687E+00, + &-0.81741E+00,-0.81795E+00,-0.81849E+00,-0.81903E+00,-0.81956E+00, + &-0.82010E+00,-0.82063E+00,-0.82117E+00,-0.82170E+00,-0.82223E+00, + &-0.82276E+00,-0.82329E+00,-0.82381E+00,-0.82434E+00,-0.82486E+00, + &-0.82538E+00,-0.82590E+00,-0.82642E+00,-0.82694E+00,-0.82746E+00, + &-0.82798E+00,-0.82849E+00,-0.82900E+00,-0.82952E+00,-0.83003E+00, + &-0.83054E+00,-0.83104E+00,-0.83155E+00,-0.83206E+00,-0.83256E+00, + &-0.83307E+00,-0.83357E+00,-0.83407E+00,-0.83457E+00,-0.83507E+00, + &-0.83556E+00,-0.83606E+00,-0.83656E+00,-0.83705E+00,-0.83754E+00, + &-0.83803E+00,-0.83852E+00,-0.83901E+00,-0.83950E+00,-0.83999E+00, + &-0.84047E+00,-0.84096E+00,-0.84144E+00,-0.84192E+00,-0.84240E+00, + &-0.84288E+00,-0.84336E+00,-0.84384E+00,-0.84432E+00,-0.84479E+00, + &-0.84527E+00,-0.84574E+00,-0.84621E+00,-0.84668E+00,-0.84715E+00, + &-0.84762E+00,-0.84809E+00,-0.84855E+00,-0.84902E+00,-0.84948E+00, + &-0.84995E+00,-0.85041E+00,-0.85087E+00,-0.85133E+00,-0.85179E+00, + &-0.85225E+00,-0.85270E+00,-0.85316E+00,-0.85361E+00,-0.85407E+00, + &-0.85452E+00,-0.85497E+00,-0.85542E+00,-0.85587E+00,-0.85632E+00/ + + DATA (BNC05M (I),I=501,600)/ + &-0.85677E+00,-0.85721E+00,-0.85766E+00,-0.85810E+00,-0.85855E+00, + &-0.85899E+00,-0.85943E+00,-0.85987E+00,-0.86031E+00,-0.86075E+00, + &-0.86119E+00,-0.86162E+00,-0.86206E+00,-0.86249E+00,-0.86293E+00, + &-0.86336E+00,-0.86379E+00,-0.86422E+00,-0.86465E+00,-0.86508E+00, + &-0.86551E+00,-0.86593E+00,-0.86636E+00,-0.86678E+00,-0.86721E+00, + &-0.86763E+00,-0.86805E+00,-0.86848E+00,-0.86890E+00,-0.86931E+00, + &-0.86973E+00,-0.87015E+00,-0.87057E+00,-0.87098E+00,-0.87140E+00, + &-0.87181E+00,-0.87222E+00,-0.87264E+00,-0.87305E+00,-0.87346E+00, + &-0.87387E+00,-0.87428E+00,-0.87468E+00,-0.87509E+00,-0.87550E+00, + &-0.87590E+00,-0.87630E+00,-0.87671E+00,-0.87711E+00,-0.87751E+00, + &-0.87791E+00,-0.87831E+00,-0.87871E+00,-0.87911E+00,-0.87951E+00, + &-0.87990E+00,-0.88030E+00,-0.88069E+00,-0.88109E+00,-0.88148E+00, + &-0.88187E+00,-0.88226E+00,-0.88265E+00,-0.88304E+00,-0.88343E+00, + &-0.88382E+00,-0.88421E+00,-0.88459E+00,-0.88498E+00,-0.88537E+00, + &-0.88575E+00,-0.88613E+00,-0.88651E+00,-0.88690E+00,-0.88728E+00, + &-0.88766E+00,-0.88804E+00,-0.88841E+00,-0.88879E+00,-0.88917E+00, + &-0.88955E+00,-0.88992E+00,-0.89030E+00,-0.89067E+00,-0.89104E+00, + &-0.89141E+00,-0.89179E+00,-0.89216E+00,-0.89253E+00,-0.89290E+00, + &-0.89326E+00,-0.89363E+00,-0.89400E+00,-0.89436E+00,-0.89473E+00, + &-0.89509E+00,-0.89546E+00,-0.89582E+00,-0.89618E+00,-0.89754E+00/ + + DATA (BNC05M (I),I=601,700)/ + &-0.90048E+00,-0.90398E+00,-0.90741E+00,-0.91077E+00,-0.91407E+00, + &-0.91731E+00,-0.92048E+00,-0.92360E+00,-0.92666E+00,-0.92966E+00, + &-0.93261E+00,-0.93551E+00,-0.93835E+00,-0.94115E+00,-0.94389E+00, + &-0.94659E+00,-0.94924E+00,-0.95185E+00,-0.95441E+00,-0.95693E+00, + &-0.95941E+00,-0.96185E+00,-0.96425E+00,-0.96661E+00,-0.96893E+00, + &-0.97121E+00,-0.97346E+00,-0.97568E+00,-0.97786E+00,-0.98000E+00, + &-0.98212E+00,-0.98420E+00,-0.98625E+00,-0.98827E+00,-0.99026E+00, + &-0.99222E+00,-0.99415E+00,-0.99605E+00,-0.99793E+00,-0.99978E+00, + &-0.10016E+01,-0.10034E+01,-0.10052E+01,-0.10069E+01,-0.10087E+01, + &-0.10104E+01,-0.10120E+01,-0.10137E+01,-0.10153E+01,-0.10169E+01, + &-0.10185E+01,-0.10201E+01,-0.10216E+01,-0.10232E+01,-0.10247E+01, + &-0.10262E+01,-0.10276E+01,-0.10291E+01,-0.10305E+01,-0.10319E+01, + &-0.10333E+01,-0.10347E+01,-0.10361E+01,-0.10374E+01,-0.10388E+01, + &-0.10401E+01,-0.10414E+01,-0.10427E+01,-0.10439E+01,-0.10452E+01, + &-0.10464E+01,-0.10477E+01,-0.10489E+01,-0.10501E+01,-0.10513E+01, + &-0.10524E+01,-0.10536E+01,-0.10547E+01,-0.10559E+01,-0.10570E+01, + &-0.10581E+01,-0.10592E+01,-0.10603E+01,-0.10613E+01,-0.10624E+01, + &-0.10635E+01,-0.10645E+01,-0.10655E+01,-0.10665E+01,-0.10675E+01, + &-0.10685E+01,-0.10695E+01,-0.10705E+01,-0.10715E+01,-0.10724E+01, + &-0.10734E+01,-0.10743E+01,-0.10752E+01,-0.10761E+01,-0.10770E+01/ + + DATA (BNC05M(I),I=701,741)/ + &-0.10779E+01,-0.10788E+01,-0.10797E+01,-0.10806E+01,-0.10814E+01, + &-0.10823E+01,-0.10831E+01,-0.10840E+01,-0.10848E+01,-0.10856E+01, + &-0.10865E+01,-0.10873E+01,-0.10881E+01,-0.10889E+01,-0.10896E+01, + &-0.10904E+01,-0.10912E+01,-0.10920E+01,-0.10927E+01,-0.10935E+01, + &-0.10942E+01,-0.10949E+01,-0.10957E+01,-0.10964E+01,-0.10971E+01, + &-0.10978E+01,-0.10985E+01,-0.10992E+01,-0.10999E+01,-0.11006E+01, + &-0.11013E+01,-0.11020E+01,-0.11026E+01,-0.11033E+01,-0.11039E+01, + &-0.11046E+01,-0.11052E+01,-0.11059E+01,-0.11065E+01,-0.11071E+01, + &-0.11078E+01 + & / +C +C *** NH4Cl +C + DATA (BNC06M (I),I= 1,100)/ + &-0.50814E-01,-0.91326E-01,-0.11891E+00,-0.13710E+00,-0.15072E+00, + &-0.16157E+00,-0.17053E+00,-0.17813E+00,-0.18469E+00,-0.19042E+00, + &-0.19549E+00,-0.20001E+00,-0.20407E+00,-0.20774E+00,-0.21107E+00, + &-0.21410E+00,-0.21687E+00,-0.21942E+00,-0.22176E+00,-0.22392E+00, + &-0.22592E+00,-0.22777E+00,-0.22948E+00,-0.23108E+00,-0.23256E+00, + &-0.23394E+00,-0.23522E+00,-0.23642E+00,-0.23754E+00,-0.23858E+00, + &-0.23956E+00,-0.24048E+00,-0.24133E+00,-0.24213E+00,-0.24288E+00, + &-0.24359E+00,-0.24424E+00,-0.24486E+00,-0.24544E+00,-0.24598E+00, + &-0.24649E+00,-0.24696E+00,-0.24741E+00,-0.24782E+00,-0.24821E+00, + &-0.24858E+00,-0.24892E+00,-0.24923E+00,-0.24953E+00,-0.24980E+00, + &-0.25006E+00,-0.25030E+00,-0.25052E+00,-0.25072E+00,-0.25091E+00, + &-0.25108E+00,-0.25123E+00,-0.25137E+00,-0.25150E+00,-0.25161E+00, + &-0.25171E+00,-0.25180E+00,-0.25188E+00,-0.25194E+00,-0.25199E+00, + &-0.25203E+00,-0.25206E+00,-0.25207E+00,-0.25208E+00,-0.25207E+00, + &-0.25205E+00,-0.25203E+00,-0.25199E+00,-0.25194E+00,-0.25188E+00, + &-0.25180E+00,-0.25172E+00,-0.25163E+00,-0.25153E+00,-0.25141E+00, + &-0.25129E+00,-0.25116E+00,-0.25101E+00,-0.25086E+00,-0.25070E+00, + &-0.25052E+00,-0.25034E+00,-0.25015E+00,-0.24994E+00,-0.24973E+00, + &-0.24951E+00,-0.24928E+00,-0.24904E+00,-0.24879E+00,-0.24854E+00, + &-0.24827E+00,-0.24800E+00,-0.24772E+00,-0.24743E+00,-0.24713E+00/ + + DATA (BNC06M (I),I=101,200)/ + &-0.24683E+00,-0.24651E+00,-0.24620E+00,-0.24587E+00,-0.24554E+00, + &-0.24520E+00,-0.24485E+00,-0.24450E+00,-0.24415E+00,-0.24379E+00, + &-0.24342E+00,-0.24305E+00,-0.24267E+00,-0.24229E+00,-0.24190E+00, + &-0.24151E+00,-0.24112E+00,-0.24072E+00,-0.24032E+00,-0.23991E+00, + &-0.23958E+00,-0.23916E+00,-0.23874E+00,-0.23831E+00,-0.23788E+00, + &-0.23745E+00,-0.23702E+00,-0.23659E+00,-0.23615E+00,-0.23572E+00, + &-0.23528E+00,-0.23484E+00,-0.23439E+00,-0.23395E+00,-0.23350E+00, + &-0.23306E+00,-0.23261E+00,-0.23216E+00,-0.23171E+00,-0.23126E+00, + &-0.23080E+00,-0.23035E+00,-0.22989E+00,-0.22944E+00,-0.22898E+00, + &-0.22852E+00,-0.22806E+00,-0.22760E+00,-0.22713E+00,-0.22667E+00, + &-0.22621E+00,-0.22574E+00,-0.22528E+00,-0.22481E+00,-0.22434E+00, + &-0.22388E+00,-0.22341E+00,-0.22294E+00,-0.22247E+00,-0.22200E+00, + &-0.22153E+00,-0.22105E+00,-0.22058E+00,-0.22011E+00,-0.21963E+00, + &-0.21916E+00,-0.21869E+00,-0.21821E+00,-0.21773E+00,-0.21726E+00, + &-0.21678E+00,-0.21631E+00,-0.21583E+00,-0.21535E+00,-0.21487E+00, + &-0.21440E+00,-0.21392E+00,-0.21344E+00,-0.21296E+00,-0.21248E+00, + &-0.21200E+00,-0.21152E+00,-0.21104E+00,-0.21056E+00,-0.21008E+00, + &-0.20960E+00,-0.20912E+00,-0.20864E+00,-0.20816E+00,-0.20768E+00, + &-0.20720E+00,-0.20672E+00,-0.20624E+00,-0.20576E+00,-0.20527E+00, + &-0.20479E+00,-0.20431E+00,-0.20383E+00,-0.20335E+00,-0.20287E+00/ + + DATA (BNC06M (I),I=201,300)/ + &-0.20239E+00,-0.20191E+00,-0.20143E+00,-0.20094E+00,-0.20046E+00, + &-0.19998E+00,-0.19950E+00,-0.19902E+00,-0.19854E+00,-0.19806E+00, + &-0.19758E+00,-0.19710E+00,-0.19662E+00,-0.19614E+00,-0.19566E+00, + &-0.19518E+00,-0.19470E+00,-0.19422E+00,-0.19374E+00,-0.19326E+00, + &-0.19278E+00,-0.19230E+00,-0.19182E+00,-0.19135E+00,-0.19087E+00, + &-0.19039E+00,-0.18991E+00,-0.18943E+00,-0.18896E+00,-0.18848E+00, + &-0.18800E+00,-0.18753E+00,-0.18705E+00,-0.18657E+00,-0.18610E+00, + &-0.18562E+00,-0.18515E+00,-0.18467E+00,-0.18420E+00,-0.18372E+00, + &-0.18325E+00,-0.18277E+00,-0.18230E+00,-0.18183E+00,-0.18135E+00, + &-0.18088E+00,-0.18041E+00,-0.17994E+00,-0.17946E+00,-0.17899E+00, + &-0.17852E+00,-0.17805E+00,-0.17758E+00,-0.17711E+00,-0.17664E+00, + &-0.17617E+00,-0.17570E+00,-0.17523E+00,-0.17476E+00,-0.17430E+00, + &-0.17383E+00,-0.17336E+00,-0.17289E+00,-0.17243E+00,-0.17196E+00, + &-0.17149E+00,-0.17103E+00,-0.17056E+00,-0.17010E+00,-0.16963E+00, + &-0.16917E+00,-0.16871E+00,-0.16824E+00,-0.16778E+00,-0.16732E+00, + &-0.16685E+00,-0.16639E+00,-0.16593E+00,-0.16547E+00,-0.16501E+00, + &-0.16455E+00,-0.16409E+00,-0.16363E+00,-0.16317E+00,-0.16271E+00, + &-0.16225E+00,-0.16179E+00,-0.16134E+00,-0.16088E+00,-0.16042E+00, + &-0.15997E+00,-0.15951E+00,-0.15905E+00,-0.15860E+00,-0.15814E+00, + &-0.15769E+00,-0.15724E+00,-0.15678E+00,-0.15633E+00,-0.15588E+00/ + + DATA (BNC06M (I),I=301,400)/ + &-0.15542E+00,-0.15497E+00,-0.15452E+00,-0.15407E+00,-0.15362E+00, + &-0.15317E+00,-0.15272E+00,-0.15227E+00,-0.15182E+00,-0.15137E+00, + &-0.15092E+00,-0.15048E+00,-0.15003E+00,-0.14958E+00,-0.14914E+00, + &-0.14869E+00,-0.14825E+00,-0.14780E+00,-0.14736E+00,-0.14691E+00, + &-0.14647E+00,-0.14602E+00,-0.14558E+00,-0.14514E+00,-0.14470E+00, + &-0.14425E+00,-0.14381E+00,-0.14337E+00,-0.14293E+00,-0.14249E+00, + &-0.14205E+00,-0.14161E+00,-0.14118E+00,-0.14074E+00,-0.14030E+00, + &-0.13986E+00,-0.13943E+00,-0.13899E+00,-0.13855E+00,-0.13812E+00, + &-0.13768E+00,-0.13725E+00,-0.13681E+00,-0.13638E+00,-0.13595E+00, + &-0.13551E+00,-0.13508E+00,-0.13465E+00,-0.13422E+00,-0.13379E+00, + &-0.13336E+00,-0.13292E+00,-0.13249E+00,-0.13207E+00,-0.13164E+00, + &-0.13121E+00,-0.13078E+00,-0.13035E+00,-0.12992E+00,-0.12950E+00, + &-0.12907E+00,-0.12865E+00,-0.12822E+00,-0.12779E+00,-0.12737E+00, + &-0.12695E+00,-0.12652E+00,-0.12610E+00,-0.12568E+00,-0.12525E+00, + &-0.12483E+00,-0.12441E+00,-0.12399E+00,-0.12357E+00,-0.12315E+00, + &-0.12273E+00,-0.12231E+00,-0.12189E+00,-0.12147E+00,-0.12105E+00, + &-0.12063E+00,-0.12022E+00,-0.11980E+00,-0.11938E+00,-0.11897E+00, + &-0.11855E+00,-0.11814E+00,-0.11772E+00,-0.11731E+00,-0.11689E+00, + &-0.11648E+00,-0.11607E+00,-0.11565E+00,-0.11524E+00,-0.11483E+00, + &-0.11442E+00,-0.11401E+00,-0.11360E+00,-0.11319E+00,-0.11278E+00/ + + DATA (BNC06M (I),I=401,500)/ + &-0.11237E+00,-0.11196E+00,-0.11155E+00,-0.11114E+00,-0.11074E+00, + &-0.11033E+00,-0.10992E+00,-0.10952E+00,-0.10911E+00,-0.10871E+00, + &-0.10830E+00,-0.10790E+00,-0.10749E+00,-0.10709E+00,-0.10668E+00, + &-0.10628E+00,-0.10588E+00,-0.10548E+00,-0.10507E+00,-0.10467E+00, + &-0.10427E+00,-0.10387E+00,-0.10347E+00,-0.10307E+00,-0.10267E+00, + &-0.10227E+00,-0.10188E+00,-0.10148E+00,-0.10108E+00,-0.10068E+00, + &-0.10029E+00,-0.99891E-01,-0.99495E-01,-0.99100E-01,-0.98704E-01, + &-0.98310E-01,-0.97915E-01,-0.97522E-01,-0.97128E-01,-0.96735E-01, + &-0.96342E-01,-0.95950E-01,-0.95558E-01,-0.95167E-01,-0.94776E-01, + &-0.94385E-01,-0.93995E-01,-0.93605E-01,-0.93216E-01,-0.92827E-01, + &-0.92438E-01,-0.92050E-01,-0.91662E-01,-0.91274E-01,-0.90887E-01, + &-0.90501E-01,-0.90114E-01,-0.89729E-01,-0.89343E-01,-0.88958E-01, + &-0.88573E-01,-0.88189E-01,-0.87805E-01,-0.87422E-01,-0.87039E-01, + &-0.86656E-01,-0.86274E-01,-0.85892E-01,-0.85510E-01,-0.85129E-01, + &-0.84748E-01,-0.84368E-01,-0.83988E-01,-0.83608E-01,-0.83229E-01, + &-0.82850E-01,-0.82472E-01,-0.82094E-01,-0.81716E-01,-0.81339E-01, + &-0.80962E-01,-0.80585E-01,-0.80209E-01,-0.79833E-01,-0.79458E-01, + &-0.79083E-01,-0.78708E-01,-0.78334E-01,-0.77960E-01,-0.77586E-01, + &-0.77213E-01,-0.76840E-01,-0.76468E-01,-0.76096E-01,-0.75724E-01, + &-0.75353E-01,-0.74982E-01,-0.74612E-01,-0.74242E-01,-0.73872E-01/ + + DATA (BNC06M (I),I=501,600)/ + &-0.73502E-01,-0.73133E-01,-0.72765E-01,-0.72396E-01,-0.72028E-01, + &-0.71661E-01,-0.71294E-01,-0.70927E-01,-0.70560E-01,-0.70194E-01, + &-0.69829E-01,-0.69463E-01,-0.69098E-01,-0.68734E-01,-0.68369E-01, + &-0.68005E-01,-0.67642E-01,-0.67279E-01,-0.66916E-01,-0.66553E-01, + &-0.66191E-01,-0.65829E-01,-0.65468E-01,-0.65107E-01,-0.64746E-01, + &-0.64386E-01,-0.64026E-01,-0.63666E-01,-0.63307E-01,-0.62948E-01, + &-0.62590E-01,-0.62232E-01,-0.61874E-01,-0.61516E-01,-0.61159E-01, + &-0.60802E-01,-0.60446E-01,-0.60090E-01,-0.59734E-01,-0.59379E-01, + &-0.59024E-01,-0.58669E-01,-0.58315E-01,-0.57961E-01,-0.57607E-01, + &-0.57254E-01,-0.56901E-01,-0.56548E-01,-0.56196E-01,-0.55844E-01, + &-0.55492E-01,-0.55141E-01,-0.54790E-01,-0.54439E-01,-0.54089E-01, + &-0.53739E-01,-0.53390E-01,-0.53040E-01,-0.52692E-01,-0.52343E-01, + &-0.51995E-01,-0.51647E-01,-0.51299E-01,-0.50952E-01,-0.50605E-01, + &-0.50259E-01,-0.49913E-01,-0.49567E-01,-0.49221E-01,-0.48876E-01, + &-0.48531E-01,-0.48187E-01,-0.47842E-01,-0.47498E-01,-0.47155E-01, + &-0.46812E-01,-0.46469E-01,-0.46126E-01,-0.45784E-01,-0.45442E-01, + &-0.45100E-01,-0.44759E-01,-0.44418E-01,-0.44078E-01,-0.43737E-01, + &-0.43397E-01,-0.43058E-01,-0.42718E-01,-0.42379E-01,-0.42041E-01, + &-0.41702E-01,-0.41364E-01,-0.41027E-01,-0.40689E-01,-0.40352E-01, + &-0.40015E-01,-0.39679E-01,-0.39343E-01,-0.39007E-01,-0.37750E-01/ + + DATA (BNC06M (I),I=601,700)/ + &-0.35001E-01,-0.31698E-01,-0.28424E-01,-0.25181E-01,-0.21967E-01, + &-0.18782E-01,-0.15626E-01,-0.12497E-01,-0.93962E-02,-0.63224E-02, + &-0.32753E-02,-0.25450E-03, 0.27406E-02, 0.57102E-02, 0.86547E-02, + & 0.11575E-01, 0.14470E-01, 0.17342E-01, 0.20191E-01, 0.23016E-01, + & 0.25819E-01, 0.28599E-01, 0.31357E-01, 0.34093E-01, 0.36808E-01, + & 0.39502E-01, 0.42175E-01, 0.44827E-01, 0.47460E-01, 0.50072E-01, + & 0.52665E-01, 0.55239E-01, 0.57793E-01, 0.60329E-01, 0.62847E-01, + & 0.65346E-01, 0.67827E-01, 0.70291E-01, 0.72737E-01, 0.75165E-01, + & 0.77577E-01, 0.79972E-01, 0.82351E-01, 0.84713E-01, 0.87059E-01, + & 0.89390E-01, 0.91704E-01, 0.94003E-01, 0.96287E-01, 0.98556E-01, + & 0.10081E+00, 0.10305E+00, 0.10527E+00, 0.10749E+00, 0.10968E+00, + & 0.11186E+00, 0.11403E+00, 0.11619E+00, 0.11833E+00, 0.12046E+00, + & 0.12257E+00, 0.12468E+00, 0.12677E+00, 0.12884E+00, 0.13091E+00, + & 0.13296E+00, 0.13500E+00, 0.13703E+00, 0.13904E+00, 0.14105E+00, + & 0.14304E+00, 0.14502E+00, 0.14699E+00, 0.14895E+00, 0.15090E+00, + & 0.15283E+00, 0.15476E+00, 0.15668E+00, 0.15858E+00, 0.16047E+00, + & 0.16236E+00, 0.16423E+00, 0.16609E+00, 0.16795E+00, 0.16979E+00, + & 0.17162E+00, 0.17345E+00, 0.17526E+00, 0.17706E+00, 0.17886E+00, + & 0.18064E+00, 0.18242E+00, 0.18419E+00, 0.18595E+00, 0.18769E+00, + & 0.18944E+00, 0.19117E+00, 0.19289E+00, 0.19460E+00, 0.19631E+00/ + + DATA (BNC06M(I),I=701,741)/ + & 0.19801E+00, 0.19970E+00, 0.20138E+00, 0.20305E+00, 0.20471E+00, + & 0.20637E+00, 0.20802E+00, 0.20966E+00, 0.21129E+00, 0.21292E+00, + & 0.21453E+00, 0.21614E+00, 0.21775E+00, 0.21934E+00, 0.22093E+00, + & 0.22251E+00, 0.22408E+00, 0.22565E+00, 0.22721E+00, 0.22876E+00, + & 0.23030E+00, 0.23184E+00, 0.23337E+00, 0.23490E+00, 0.23641E+00, + & 0.23792E+00, 0.23943E+00, 0.24093E+00, 0.24242E+00, 0.24390E+00, + & 0.24538E+00, 0.24685E+00, 0.24832E+00, 0.24978E+00, 0.25123E+00, + & 0.25268E+00, 0.25412E+00, 0.25555E+00, 0.25698E+00, 0.25840E+00, + & 0.25982E+00 + & / +C +C *** (2H, SO4) +C + DATA (BNC07M (I),I= 1,100)/ + &-0.10285E+00,-0.18717E+00,-0.24637E+00,-0.28657E+00,-0.31747E+00, + &-0.34271E+00,-0.36411E+00,-0.38270E+00,-0.39914E+00,-0.41388E+00, + &-0.42725E+00,-0.43947E+00,-0.45073E+00,-0.46116E+00,-0.47088E+00, + &-0.47998E+00,-0.48853E+00,-0.49659E+00,-0.50422E+00,-0.51145E+00, + &-0.51833E+00,-0.52489E+00,-0.53115E+00,-0.53714E+00,-0.54288E+00, + &-0.54839E+00,-0.55369E+00,-0.55879E+00,-0.56371E+00,-0.56845E+00, + &-0.57304E+00,-0.57747E+00,-0.58177E+00,-0.58593E+00,-0.58996E+00, + &-0.59388E+00,-0.59768E+00,-0.60138E+00,-0.60497E+00,-0.60847E+00, + &-0.61188E+00,-0.61521E+00,-0.61845E+00,-0.62161E+00,-0.62469E+00, + &-0.62770E+00,-0.63065E+00,-0.63352E+00,-0.63634E+00,-0.63909E+00, + &-0.64178E+00,-0.64442E+00,-0.64700E+00,-0.64953E+00,-0.65201E+00, + &-0.65445E+00,-0.65683E+00,-0.65917E+00,-0.66147E+00,-0.66373E+00, + &-0.66594E+00,-0.66812E+00,-0.67026E+00,-0.67236E+00,-0.67443E+00, + &-0.67646E+00,-0.67846E+00,-0.68043E+00,-0.68237E+00,-0.68427E+00, + &-0.68615E+00,-0.68800E+00,-0.68983E+00,-0.69162E+00,-0.69339E+00, + &-0.69514E+00,-0.69686E+00,-0.69856E+00,-0.70024E+00,-0.70189E+00, + &-0.70352E+00,-0.70514E+00,-0.70673E+00,-0.70830E+00,-0.70985E+00, + &-0.71139E+00,-0.71290E+00,-0.71440E+00,-0.71588E+00,-0.71734E+00, + &-0.71879E+00,-0.72022E+00,-0.72164E+00,-0.72304E+00,-0.72442E+00, + &-0.72579E+00,-0.72715E+00,-0.72849E+00,-0.72982E+00,-0.73113E+00/ + + DATA (BNC07M (I),I=101,200)/ + &-0.73243E+00,-0.73372E+00,-0.73500E+00,-0.73626E+00,-0.73751E+00, + &-0.73875E+00,-0.73998E+00,-0.74119E+00,-0.74240E+00,-0.74359E+00, + &-0.74477E+00,-0.74594E+00,-0.74710E+00,-0.74825E+00,-0.74939E+00, + &-0.75052E+00,-0.75164E+00,-0.75275E+00,-0.75385E+00,-0.75494E+00, + &-0.75600E+00,-0.75708E+00,-0.75814E+00,-0.75920E+00,-0.76025E+00, + &-0.76128E+00,-0.76231E+00,-0.76333E+00,-0.76435E+00,-0.76535E+00, + &-0.76634E+00,-0.76733E+00,-0.76831E+00,-0.76928E+00,-0.77025E+00, + &-0.77120E+00,-0.77215E+00,-0.77310E+00,-0.77403E+00,-0.77496E+00, + &-0.77588E+00,-0.77679E+00,-0.77770E+00,-0.77860E+00,-0.77949E+00, + &-0.78038E+00,-0.78126E+00,-0.78213E+00,-0.78300E+00,-0.78386E+00, + &-0.78472E+00,-0.78557E+00,-0.78641E+00,-0.78725E+00,-0.78808E+00, + &-0.78890E+00,-0.78972E+00,-0.79054E+00,-0.79135E+00,-0.79215E+00, + &-0.79295E+00,-0.79374E+00,-0.79453E+00,-0.79531E+00,-0.79609E+00, + &-0.79686E+00,-0.79763E+00,-0.79840E+00,-0.79915E+00,-0.79991E+00, + &-0.80065E+00,-0.80140E+00,-0.80214E+00,-0.80287E+00,-0.80360E+00, + &-0.80433E+00,-0.80505E+00,-0.80577E+00,-0.80648E+00,-0.80719E+00, + &-0.80789E+00,-0.80859E+00,-0.80929E+00,-0.80998E+00,-0.81067E+00, + &-0.81135E+00,-0.81203E+00,-0.81271E+00,-0.81338E+00,-0.81405E+00, + &-0.81471E+00,-0.81537E+00,-0.81603E+00,-0.81669E+00,-0.81734E+00, + &-0.81798E+00,-0.81863E+00,-0.81926E+00,-0.81990E+00,-0.82053E+00/ + + DATA (BNC07M (I),I=201,300)/ + &-0.82116E+00,-0.82179E+00,-0.82241E+00,-0.82303E+00,-0.82365E+00, + &-0.82426E+00,-0.82487E+00,-0.82548E+00,-0.82608E+00,-0.82668E+00, + &-0.82728E+00,-0.82787E+00,-0.82846E+00,-0.82905E+00,-0.82963E+00, + &-0.83022E+00,-0.83080E+00,-0.83137E+00,-0.83195E+00,-0.83252E+00, + &-0.83309E+00,-0.83365E+00,-0.83421E+00,-0.83477E+00,-0.83533E+00, + &-0.83589E+00,-0.83644E+00,-0.83699E+00,-0.83753E+00,-0.83808E+00, + &-0.83862E+00,-0.83916E+00,-0.83970E+00,-0.84023E+00,-0.84076E+00, + &-0.84129E+00,-0.84182E+00,-0.84234E+00,-0.84286E+00,-0.84338E+00, + &-0.84390E+00,-0.84442E+00,-0.84493E+00,-0.84544E+00,-0.84595E+00, + &-0.84645E+00,-0.84696E+00,-0.84746E+00,-0.84796E+00,-0.84846E+00, + &-0.84895E+00,-0.84945E+00,-0.84994E+00,-0.85043E+00,-0.85091E+00, + &-0.85140E+00,-0.85188E+00,-0.85236E+00,-0.85284E+00,-0.85332E+00, + &-0.85379E+00,-0.85426E+00,-0.85473E+00,-0.85520E+00,-0.85567E+00, + &-0.85614E+00,-0.85660E+00,-0.85706E+00,-0.85752E+00,-0.85798E+00, + &-0.85843E+00,-0.85889E+00,-0.85934E+00,-0.85979E+00,-0.86024E+00, + &-0.86069E+00,-0.86113E+00,-0.86157E+00,-0.86202E+00,-0.86246E+00, + &-0.86289E+00,-0.86333E+00,-0.86377E+00,-0.86420E+00,-0.86463E+00, + &-0.86506E+00,-0.86549E+00,-0.86592E+00,-0.86634E+00,-0.86676E+00, + &-0.86719E+00,-0.86761E+00,-0.86803E+00,-0.86844E+00,-0.86886E+00, + &-0.86927E+00,-0.86969E+00,-0.87010E+00,-0.87051E+00,-0.87091E+00/ + + DATA (BNC07M (I),I=301,400)/ + &-0.87132E+00,-0.87173E+00,-0.87213E+00,-0.87253E+00,-0.87293E+00, + &-0.87333E+00,-0.87373E+00,-0.87413E+00,-0.87452E+00,-0.87492E+00, + &-0.87531E+00,-0.87570E+00,-0.87609E+00,-0.87648E+00,-0.87687E+00, + &-0.87725E+00,-0.87764E+00,-0.87802E+00,-0.87840E+00,-0.87878E+00, + &-0.87916E+00,-0.87954E+00,-0.87992E+00,-0.88029E+00,-0.88067E+00, + &-0.88104E+00,-0.88141E+00,-0.88178E+00,-0.88215E+00,-0.88252E+00, + &-0.88289E+00,-0.88325E+00,-0.88362E+00,-0.88398E+00,-0.88434E+00, + &-0.88470E+00,-0.88506E+00,-0.88542E+00,-0.88578E+00,-0.88614E+00, + &-0.88649E+00,-0.88685E+00,-0.88720E+00,-0.88755E+00,-0.88790E+00, + &-0.88825E+00,-0.88860E+00,-0.88895E+00,-0.88929E+00,-0.88964E+00, + &-0.88998E+00,-0.89033E+00,-0.89067E+00,-0.89101E+00,-0.89135E+00, + &-0.89169E+00,-0.89203E+00,-0.89236E+00,-0.89270E+00,-0.89303E+00, + &-0.89337E+00,-0.89370E+00,-0.89403E+00,-0.89436E+00,-0.89469E+00, + &-0.89502E+00,-0.89535E+00,-0.89568E+00,-0.89600E+00,-0.89633E+00, + &-0.89665E+00,-0.89697E+00,-0.89730E+00,-0.89762E+00,-0.89794E+00, + &-0.89826E+00,-0.89857E+00,-0.89889E+00,-0.89921E+00,-0.89952E+00, + &-0.89984E+00,-0.90015E+00,-0.90047E+00,-0.90078E+00,-0.90109E+00, + &-0.90140E+00,-0.90171E+00,-0.90202E+00,-0.90232E+00,-0.90263E+00, + &-0.90294E+00,-0.90324E+00,-0.90355E+00,-0.90385E+00,-0.90415E+00, + &-0.90445E+00,-0.90475E+00,-0.90505E+00,-0.90535E+00,-0.90565E+00/ + + DATA (BNC07M (I),I=401,500)/ + &-0.90595E+00,-0.90625E+00,-0.90654E+00,-0.90684E+00,-0.90713E+00, + &-0.90743E+00,-0.90772E+00,-0.90801E+00,-0.90830E+00,-0.90859E+00, + &-0.90888E+00,-0.90917E+00,-0.90946E+00,-0.90975E+00,-0.91003E+00, + &-0.91032E+00,-0.91060E+00,-0.91089E+00,-0.91117E+00,-0.91145E+00, + &-0.91174E+00,-0.91202E+00,-0.91230E+00,-0.91258E+00,-0.91286E+00, + &-0.91314E+00,-0.91341E+00,-0.91369E+00,-0.91397E+00,-0.91424E+00, + &-0.91452E+00,-0.91479E+00,-0.91507E+00,-0.91534E+00,-0.91561E+00, + &-0.91588E+00,-0.91615E+00,-0.91642E+00,-0.91669E+00,-0.91696E+00, + &-0.91723E+00,-0.91750E+00,-0.91776E+00,-0.91803E+00,-0.91830E+00, + &-0.91856E+00,-0.91883E+00,-0.91909E+00,-0.91935E+00,-0.91961E+00, + &-0.91988E+00,-0.92014E+00,-0.92040E+00,-0.92066E+00,-0.92092E+00, + &-0.92117E+00,-0.92143E+00,-0.92169E+00,-0.92195E+00,-0.92220E+00, + &-0.92246E+00,-0.92271E+00,-0.92297E+00,-0.92322E+00,-0.92347E+00, + &-0.92373E+00,-0.92398E+00,-0.92423E+00,-0.92448E+00,-0.92473E+00, + &-0.92498E+00,-0.92523E+00,-0.92548E+00,-0.92572E+00,-0.92597E+00, + &-0.92622E+00,-0.92646E+00,-0.92671E+00,-0.92695E+00,-0.92720E+00, + &-0.92744E+00,-0.92768E+00,-0.92793E+00,-0.92817E+00,-0.92841E+00, + &-0.92865E+00,-0.92889E+00,-0.92913E+00,-0.92937E+00,-0.92961E+00, + &-0.92985E+00,-0.93009E+00,-0.93032E+00,-0.93056E+00,-0.93080E+00, + &-0.93103E+00,-0.93127E+00,-0.93150E+00,-0.93174E+00,-0.93197E+00/ + + DATA (BNC07M (I),I=501,600)/ + &-0.93220E+00,-0.93243E+00,-0.93267E+00,-0.93290E+00,-0.93313E+00, + &-0.93336E+00,-0.93359E+00,-0.93382E+00,-0.93405E+00,-0.93428E+00, + &-0.93450E+00,-0.93473E+00,-0.93496E+00,-0.93519E+00,-0.93541E+00, + &-0.93564E+00,-0.93586E+00,-0.93609E+00,-0.93631E+00,-0.93653E+00, + &-0.93676E+00,-0.93698E+00,-0.93720E+00,-0.93742E+00,-0.93765E+00, + &-0.93787E+00,-0.93809E+00,-0.93831E+00,-0.93853E+00,-0.93875E+00, + &-0.93896E+00,-0.93918E+00,-0.93940E+00,-0.93962E+00,-0.93983E+00, + &-0.94005E+00,-0.94027E+00,-0.94048E+00,-0.94070E+00,-0.94091E+00, + &-0.94112E+00,-0.94134E+00,-0.94155E+00,-0.94176E+00,-0.94198E+00, + &-0.94219E+00,-0.94240E+00,-0.94261E+00,-0.94282E+00,-0.94303E+00, + &-0.94324E+00,-0.94345E+00,-0.94366E+00,-0.94387E+00,-0.94408E+00, + &-0.94428E+00,-0.94449E+00,-0.94470E+00,-0.94491E+00,-0.94511E+00, + &-0.94532E+00,-0.94552E+00,-0.94573E+00,-0.94593E+00,-0.94614E+00, + &-0.94634E+00,-0.94654E+00,-0.94675E+00,-0.94695E+00,-0.94715E+00, + &-0.94735E+00,-0.94755E+00,-0.94775E+00,-0.94795E+00,-0.94815E+00, + &-0.94835E+00,-0.94855E+00,-0.94875E+00,-0.94895E+00,-0.94915E+00, + &-0.94935E+00,-0.94954E+00,-0.94974E+00,-0.94994E+00,-0.95014E+00, + &-0.95033E+00,-0.95053E+00,-0.95072E+00,-0.95092E+00,-0.95111E+00, + &-0.95131E+00,-0.95150E+00,-0.95169E+00,-0.95189E+00,-0.95208E+00, + &-0.95227E+00,-0.95246E+00,-0.95265E+00,-0.95285E+00,-0.95356E+00/ + + DATA (BNC07M (I),I=601,700)/ + &-0.95511E+00,-0.95697E+00,-0.95879E+00,-0.96057E+00,-0.96233E+00, + &-0.96406E+00,-0.96576E+00,-0.96743E+00,-0.96907E+00,-0.97069E+00, + &-0.97228E+00,-0.97385E+00,-0.97539E+00,-0.97691E+00,-0.97841E+00, + &-0.97989E+00,-0.98134E+00,-0.98277E+00,-0.98418E+00,-0.98558E+00, + &-0.98695E+00,-0.98830E+00,-0.98964E+00,-0.99096E+00,-0.99226E+00, + &-0.99354E+00,-0.99481E+00,-0.99606E+00,-0.99730E+00,-0.99852E+00, + &-0.99972E+00,-0.10009E+01,-0.10021E+01,-0.10032E+01,-0.10044E+01, + &-0.10055E+01,-0.10067E+01,-0.10078E+01,-0.10089E+01,-0.10099E+01, + &-0.10110E+01,-0.10121E+01,-0.10131E+01,-0.10142E+01,-0.10152E+01, + &-0.10162E+01,-0.10172E+01,-0.10182E+01,-0.10192E+01,-0.10201E+01, + &-0.10211E+01,-0.10221E+01,-0.10230E+01,-0.10239E+01,-0.10249E+01, + &-0.10258E+01,-0.10267E+01,-0.10276E+01,-0.10285E+01,-0.10293E+01, + &-0.10302E+01,-0.10311E+01,-0.10319E+01,-0.10328E+01,-0.10336E+01, + &-0.10345E+01,-0.10353E+01,-0.10361E+01,-0.10369E+01,-0.10377E+01, + &-0.10385E+01,-0.10393E+01,-0.10401E+01,-0.10409E+01,-0.10416E+01, + &-0.10424E+01,-0.10432E+01,-0.10439E+01,-0.10447E+01,-0.10454E+01, + &-0.10461E+01,-0.10469E+01,-0.10476E+01,-0.10483E+01,-0.10490E+01, + &-0.10497E+01,-0.10504E+01,-0.10511E+01,-0.10518E+01,-0.10525E+01, + &-0.10532E+01,-0.10538E+01,-0.10545E+01,-0.10552E+01,-0.10558E+01, + &-0.10565E+01,-0.10571E+01,-0.10578E+01,-0.10584E+01,-0.10591E+01/ + + DATA (BNC07M(I),I=701,741)/ + &-0.10597E+01,-0.10603E+01,-0.10609E+01,-0.10616E+01,-0.10622E+01, + &-0.10628E+01,-0.10634E+01,-0.10640E+01,-0.10646E+01,-0.10652E+01, + &-0.10658E+01,-0.10663E+01,-0.10669E+01,-0.10675E+01,-0.10681E+01, + &-0.10687E+01,-0.10692E+01,-0.10698E+01,-0.10703E+01,-0.10709E+01, + &-0.10714E+01,-0.10720E+01,-0.10725E+01,-0.10731E+01,-0.10736E+01, + &-0.10742E+01,-0.10747E+01,-0.10752E+01,-0.10757E+01,-0.10763E+01, + &-0.10768E+01,-0.10773E+01,-0.10778E+01,-0.10783E+01,-0.10788E+01, + &-0.10793E+01,-0.10798E+01,-0.10803E+01,-0.10808E+01,-0.10813E+01, + &-0.10818E+01 + & / +C +C *** (H, HSO4) +C + DATA (BNC08M (I),I= 1,100)/ + &-0.48178E-01,-0.82334E-01,-0.10277E+00,-0.11452E+00,-0.12211E+00, + &-0.12718E+00,-0.13053E+00,-0.13262E+00,-0.13374E+00,-0.13407E+00, + &-0.13376E+00,-0.13289E+00,-0.13155E+00,-0.12979E+00,-0.12766E+00, + &-0.12519E+00,-0.12242E+00,-0.11937E+00,-0.11607E+00,-0.11252E+00, + &-0.10875E+00,-0.10478E+00,-0.10060E+00,-0.96246E-01,-0.91714E-01, + &-0.87015E-01,-0.82158E-01,-0.77151E-01,-0.72001E-01,-0.66714E-01, + &-0.61297E-01,-0.55755E-01,-0.50094E-01,-0.44319E-01,-0.38434E-01, + &-0.32445E-01,-0.26356E-01,-0.20172E-01,-0.13895E-01,-0.75315E-02, + &-0.10835E-02, 0.54448E-02, 0.12050E-01, 0.18729E-01, 0.25479E-01, + & 0.32296E-01, 0.39178E-01, 0.46121E-01, 0.53125E-01, 0.60185E-01, + & 0.67299E-01, 0.74467E-01, 0.81685E-01, 0.88951E-01, 0.96265E-01, + & 0.10362E+00, 0.11103E+00, 0.11847E+00, 0.12596E+00, 0.13349E+00, + & 0.14106E+00, 0.14866E+00, 0.15631E+00, 0.16400E+00, 0.17172E+00, + & 0.17948E+00, 0.18727E+00, 0.19511E+00, 0.20298E+00, 0.21089E+00, + & 0.21884E+00, 0.22683E+00, 0.23486E+00, 0.24293E+00, 0.25103E+00, + & 0.25918E+00, 0.26737E+00, 0.27560E+00, 0.28387E+00, 0.29219E+00, + & 0.30055E+00, 0.30895E+00, 0.31740E+00, 0.32589E+00, 0.33443E+00, + & 0.34301E+00, 0.35163E+00, 0.36030E+00, 0.36901E+00, 0.37777E+00, + & 0.38658E+00, 0.39542E+00, 0.40431E+00, 0.41324E+00, 0.42221E+00, + & 0.43122E+00, 0.44027E+00, 0.44936E+00, 0.45849E+00, 0.46765E+00/ + + DATA (BNC08M (I),I=101,200)/ + & 0.47684E+00, 0.48607E+00, 0.49533E+00, 0.50462E+00, 0.51393E+00, + & 0.52328E+00, 0.53264E+00, 0.54203E+00, 0.55144E+00, 0.56087E+00, + & 0.57032E+00, 0.57979E+00, 0.58926E+00, 0.59876E+00, 0.60826E+00, + & 0.61777E+00, 0.62729E+00, 0.63682E+00, 0.64635E+00, 0.65589E+00, + & 0.66464E+00, 0.67427E+00, 0.68389E+00, 0.69350E+00, 0.70310E+00, + & 0.71269E+00, 0.72227E+00, 0.73184E+00, 0.74139E+00, 0.75094E+00, + & 0.76047E+00, 0.76999E+00, 0.77950E+00, 0.78899E+00, 0.79847E+00, + & 0.80794E+00, 0.81739E+00, 0.82683E+00, 0.83625E+00, 0.84566E+00, + & 0.85506E+00, 0.86444E+00, 0.87380E+00, 0.88315E+00, 0.89249E+00, + & 0.90181E+00, 0.91111E+00, 0.92039E+00, 0.92966E+00, 0.93892E+00, + & 0.94816E+00, 0.95738E+00, 0.96658E+00, 0.97577E+00, 0.98494E+00, + & 0.99409E+00, 0.10032E+01, 0.10123E+01, 0.10215E+01, 0.10305E+01, + & 0.10396E+01, 0.10487E+01, 0.10577E+01, 0.10667E+01, 0.10757E+01, + & 0.10847E+01, 0.10936E+01, 0.11026E+01, 0.11115E+01, 0.11204E+01, + & 0.11293E+01, 0.11382E+01, 0.11470E+01, 0.11559E+01, 0.11647E+01, + & 0.11735E+01, 0.11823E+01, 0.11910E+01, 0.11998E+01, 0.12085E+01, + & 0.12172E+01, 0.12259E+01, 0.12346E+01, 0.12432E+01, 0.12519E+01, + & 0.12605E+01, 0.12691E+01, 0.12777E+01, 0.12862E+01, 0.12948E+01, + & 0.13033E+01, 0.13118E+01, 0.13203E+01, 0.13288E+01, 0.13372E+01, + & 0.13457E+01, 0.13541E+01, 0.13625E+01, 0.13709E+01, 0.13793E+01/ + + DATA (BNC08M (I),I=201,300)/ + & 0.13876E+01, 0.13959E+01, 0.14043E+01, 0.14126E+01, 0.14208E+01, + & 0.14291E+01, 0.14373E+01, 0.14456E+01, 0.14538E+01, 0.14620E+01, + & 0.14701E+01, 0.14783E+01, 0.14864E+01, 0.14945E+01, 0.15027E+01, + & 0.15107E+01, 0.15188E+01, 0.15269E+01, 0.15349E+01, 0.15429E+01, + & 0.15509E+01, 0.15589E+01, 0.15669E+01, 0.15748E+01, 0.15828E+01, + & 0.15907E+01, 0.15986E+01, 0.16065E+01, 0.16143E+01, 0.16222E+01, + & 0.16300E+01, 0.16378E+01, 0.16456E+01, 0.16534E+01, 0.16612E+01, + & 0.16689E+01, 0.16767E+01, 0.16844E+01, 0.16921E+01, 0.16998E+01, + & 0.17075E+01, 0.17151E+01, 0.17227E+01, 0.17304E+01, 0.17380E+01, + & 0.17456E+01, 0.17531E+01, 0.17607E+01, 0.17683E+01, 0.17758E+01, + & 0.17833E+01, 0.17908E+01, 0.17983E+01, 0.18057E+01, 0.18132E+01, + & 0.18206E+01, 0.18281E+01, 0.18355E+01, 0.18429E+01, 0.18502E+01, + & 0.18576E+01, 0.18649E+01, 0.18723E+01, 0.18796E+01, 0.18869E+01, + & 0.18942E+01, 0.19014E+01, 0.19087E+01, 0.19159E+01, 0.19232E+01, + & 0.19304E+01, 0.19376E+01, 0.19448E+01, 0.19519E+01, 0.19591E+01, + & 0.19662E+01, 0.19734E+01, 0.19805E+01, 0.19876E+01, 0.19947E+01, + & 0.20017E+01, 0.20088E+01, 0.20158E+01, 0.20229E+01, 0.20299E+01, + & 0.20369E+01, 0.20439E+01, 0.20509E+01, 0.20578E+01, 0.20648E+01, + & 0.20717E+01, 0.20786E+01, 0.20855E+01, 0.20924E+01, 0.20993E+01, + & 0.21062E+01, 0.21130E+01, 0.21199E+01, 0.21267E+01, 0.21335E+01/ + + DATA (BNC08M (I),I=301,400)/ + & 0.21403E+01, 0.21471E+01, 0.21539E+01, 0.21606E+01, 0.21674E+01, + & 0.21741E+01, 0.21808E+01, 0.21875E+01, 0.21942E+01, 0.22009E+01, + & 0.22076E+01, 0.22143E+01, 0.22209E+01, 0.22275E+01, 0.22342E+01, + & 0.22408E+01, 0.22474E+01, 0.22540E+01, 0.22605E+01, 0.22671E+01, + & 0.22737E+01, 0.22802E+01, 0.22867E+01, 0.22932E+01, 0.22997E+01, + & 0.23062E+01, 0.23127E+01, 0.23192E+01, 0.23256E+01, 0.23321E+01, + & 0.23385E+01, 0.23449E+01, 0.23513E+01, 0.23577E+01, 0.23641E+01, + & 0.23705E+01, 0.23768E+01, 0.23832E+01, 0.23895E+01, 0.23958E+01, + & 0.24021E+01, 0.24084E+01, 0.24147E+01, 0.24210E+01, 0.24273E+01, + & 0.24335E+01, 0.24398E+01, 0.24460E+01, 0.24522E+01, 0.24585E+01, + & 0.24647E+01, 0.24709E+01, 0.24770E+01, 0.24832E+01, 0.24894E+01, + & 0.24955E+01, 0.25016E+01, 0.25078E+01, 0.25139E+01, 0.25200E+01, + & 0.25261E+01, 0.25322E+01, 0.25382E+01, 0.25443E+01, 0.25504E+01, + & 0.25564E+01, 0.25624E+01, 0.25685E+01, 0.25745E+01, 0.25805E+01, + & 0.25865E+01, 0.25924E+01, 0.25984E+01, 0.26044E+01, 0.26103E+01, + & 0.26163E+01, 0.26222E+01, 0.26281E+01, 0.26340E+01, 0.26399E+01, + & 0.26458E+01, 0.26517E+01, 0.26576E+01, 0.26634E+01, 0.26693E+01, + & 0.26751E+01, 0.26809E+01, 0.26868E+01, 0.26926E+01, 0.26984E+01, + & 0.27042E+01, 0.27099E+01, 0.27157E+01, 0.27215E+01, 0.27272E+01, + & 0.27330E+01, 0.27387E+01, 0.27444E+01, 0.27501E+01, 0.27559E+01/ + + DATA (BNC08M (I),I=401,500)/ + & 0.27615E+01, 0.27672E+01, 0.27729E+01, 0.27786E+01, 0.27842E+01, + & 0.27899E+01, 0.27955E+01, 0.28012E+01, 0.28068E+01, 0.28124E+01, + & 0.28180E+01, 0.28236E+01, 0.28292E+01, 0.28348E+01, 0.28403E+01, + & 0.28459E+01, 0.28515E+01, 0.28570E+01, 0.28625E+01, 0.28681E+01, + & 0.28736E+01, 0.28791E+01, 0.28846E+01, 0.28901E+01, 0.28956E+01, + & 0.29010E+01, 0.29065E+01, 0.29119E+01, 0.29174E+01, 0.29228E+01, + & 0.29283E+01, 0.29337E+01, 0.29391E+01, 0.29445E+01, 0.29499E+01, + & 0.29553E+01, 0.29607E+01, 0.29660E+01, 0.29714E+01, 0.29768E+01, + & 0.29821E+01, 0.29874E+01, 0.29928E+01, 0.29981E+01, 0.30034E+01, + & 0.30087E+01, 0.30140E+01, 0.30193E+01, 0.30246E+01, 0.30299E+01, + & 0.30351E+01, 0.30404E+01, 0.30456E+01, 0.30509E+01, 0.30561E+01, + & 0.30613E+01, 0.30666E+01, 0.30718E+01, 0.30770E+01, 0.30822E+01, + & 0.30874E+01, 0.30925E+01, 0.30977E+01, 0.31029E+01, 0.31080E+01, + & 0.31132E+01, 0.31183E+01, 0.31235E+01, 0.31286E+01, 0.31337E+01, + & 0.31388E+01, 0.31439E+01, 0.31490E+01, 0.31541E+01, 0.31592E+01, + & 0.31643E+01, 0.31693E+01, 0.31744E+01, 0.31794E+01, 0.31845E+01, + & 0.31895E+01, 0.31945E+01, 0.31996E+01, 0.32046E+01, 0.32096E+01, + & 0.32146E+01, 0.32196E+01, 0.32246E+01, 0.32296E+01, 0.32345E+01, + & 0.32395E+01, 0.32444E+01, 0.32494E+01, 0.32543E+01, 0.32593E+01, + & 0.32642E+01, 0.32691E+01, 0.32740E+01, 0.32790E+01, 0.32839E+01/ + + DATA (BNC08M (I),I=501,600)/ + & 0.32888E+01, 0.32936E+01, 0.32985E+01, 0.33034E+01, 0.33083E+01, + & 0.33131E+01, 0.33180E+01, 0.33228E+01, 0.33277E+01, 0.33325E+01, + & 0.33373E+01, 0.33421E+01, 0.33470E+01, 0.33518E+01, 0.33566E+01, + & 0.33614E+01, 0.33662E+01, 0.33709E+01, 0.33757E+01, 0.33805E+01, + & 0.33852E+01, 0.33900E+01, 0.33947E+01, 0.33995E+01, 0.34042E+01, + & 0.34089E+01, 0.34137E+01, 0.34184E+01, 0.34231E+01, 0.34278E+01, + & 0.34325E+01, 0.34372E+01, 0.34419E+01, 0.34465E+01, 0.34512E+01, + & 0.34559E+01, 0.34605E+01, 0.34652E+01, 0.34698E+01, 0.34745E+01, + & 0.34791E+01, 0.34837E+01, 0.34884E+01, 0.34930E+01, 0.34976E+01, + & 0.35022E+01, 0.35068E+01, 0.35114E+01, 0.35160E+01, 0.35205E+01, + & 0.35251E+01, 0.35297E+01, 0.35342E+01, 0.35388E+01, 0.35433E+01, + & 0.35479E+01, 0.35524E+01, 0.35569E+01, 0.35615E+01, 0.35660E+01, + & 0.35705E+01, 0.35750E+01, 0.35795E+01, 0.35840E+01, 0.35885E+01, + & 0.35930E+01, 0.35975E+01, 0.36019E+01, 0.36064E+01, 0.36109E+01, + & 0.36153E+01, 0.36198E+01, 0.36242E+01, 0.36286E+01, 0.36331E+01, + & 0.36375E+01, 0.36419E+01, 0.36463E+01, 0.36508E+01, 0.36552E+01, + & 0.36596E+01, 0.36639E+01, 0.36683E+01, 0.36727E+01, 0.36771E+01, + & 0.36815E+01, 0.36858E+01, 0.36902E+01, 0.36945E+01, 0.36989E+01, + & 0.37032E+01, 0.37076E+01, 0.37119E+01, 0.37162E+01, 0.37206E+01, + & 0.37249E+01, 0.37292E+01, 0.37335E+01, 0.37378E+01, 0.37539E+01/ + + DATA (BNC08M (I),I=601,700)/ + & 0.37890E+01, 0.38311E+01, 0.38727E+01, 0.39138E+01, 0.39544E+01, + & 0.39945E+01, 0.40342E+01, 0.40734E+01, 0.41122E+01, 0.41506E+01, + & 0.41885E+01, 0.42261E+01, 0.42632E+01, 0.42999E+01, 0.43363E+01, + & 0.43722E+01, 0.44078E+01, 0.44431E+01, 0.44780E+01, 0.45125E+01, + & 0.45467E+01, 0.45806E+01, 0.46141E+01, 0.46473E+01, 0.46802E+01, + & 0.47128E+01, 0.47451E+01, 0.47771E+01, 0.48088E+01, 0.48402E+01, + & 0.48713E+01, 0.49022E+01, 0.49327E+01, 0.49630E+01, 0.49931E+01, + & 0.50229E+01, 0.50524E+01, 0.50817E+01, 0.51107E+01, 0.51395E+01, + & 0.51681E+01, 0.51964E+01, 0.52245E+01, 0.52524E+01, 0.52800E+01, + & 0.53074E+01, 0.53346E+01, 0.53616E+01, 0.53884E+01, 0.54150E+01, + & 0.54414E+01, 0.54676E+01, 0.54936E+01, 0.55194E+01, 0.55450E+01, + & 0.55704E+01, 0.55956E+01, 0.56206E+01, 0.56455E+01, 0.56702E+01, + & 0.56947E+01, 0.57191E+01, 0.57432E+01, 0.57672E+01, 0.57911E+01, + & 0.58148E+01, 0.58383E+01, 0.58616E+01, 0.58848E+01, 0.59079E+01, + & 0.59308E+01, 0.59535E+01, 0.59761E+01, 0.59986E+01, 0.60209E+01, + & 0.60430E+01, 0.60650E+01, 0.60869E+01, 0.61087E+01, 0.61303E+01, + & 0.61517E+01, 0.61731E+01, 0.61943E+01, 0.62154E+01, 0.62363E+01, + & 0.62572E+01, 0.62779E+01, 0.62984E+01, 0.63189E+01, 0.63392E+01, + & 0.63595E+01, 0.63796E+01, 0.63996E+01, 0.64194E+01, 0.64392E+01, + & 0.64588E+01, 0.64784E+01, 0.64978E+01, 0.65171E+01, 0.65363E+01/ + + DATA (BNC08M(I),I=701,741)/ + & 0.65554E+01, 0.65744E+01, 0.65933E+01, 0.66121E+01, 0.66308E+01, + & 0.66494E+01, 0.66679E+01, 0.66863E+01, 0.67046E+01, 0.67228E+01, + & 0.67409E+01, 0.67589E+01, 0.67768E+01, 0.67947E+01, 0.68124E+01, + & 0.68300E+01, 0.68476E+01, 0.68651E+01, 0.68824E+01, 0.68997E+01, + & 0.69169E+01, 0.69341E+01, 0.69511E+01, 0.69680E+01, 0.69849E+01, + & 0.70017E+01, 0.70184E+01, 0.70350E+01, 0.70516E+01, 0.70681E+01, + & 0.70845E+01, 0.71008E+01, 0.71170E+01, 0.71332E+01, 0.71493E+01, + & 0.71653E+01, 0.71812E+01, 0.71971E+01, 0.72129E+01, 0.72286E+01, + & 0.72442E+01 + & / +C +C *** NH4HSO4 +C + DATA (BNC09M (I),I= 1,100)/ + &-0.50460E-01,-0.90365E-01,-0.11751E+00,-0.13545E+00,-0.14891E+00, + &-0.15966E+00,-0.16855E+00,-0.17609E+00,-0.18259E+00,-0.18826E+00, + &-0.19325E+00,-0.19767E+00,-0.20160E+00,-0.20511E+00,-0.20826E+00, + &-0.21107E+00,-0.21359E+00,-0.21585E+00,-0.21786E+00,-0.21965E+00, + &-0.22123E+00,-0.22262E+00,-0.22384E+00,-0.22488E+00,-0.22578E+00, + &-0.22652E+00,-0.22713E+00,-0.22760E+00,-0.22795E+00,-0.22817E+00, + &-0.22829E+00,-0.22829E+00,-0.22819E+00,-0.22799E+00,-0.22770E+00, + &-0.22731E+00,-0.22683E+00,-0.22627E+00,-0.22563E+00,-0.22491E+00, + &-0.22411E+00,-0.22324E+00,-0.22230E+00,-0.22129E+00,-0.22021E+00, + &-0.21907E+00,-0.21788E+00,-0.21662E+00,-0.21530E+00,-0.21394E+00, + &-0.21251E+00,-0.21104E+00,-0.20952E+00,-0.20795E+00,-0.20634E+00, + &-0.20468E+00,-0.20297E+00,-0.20123E+00,-0.19944E+00,-0.19762E+00, + &-0.19576E+00,-0.19386E+00,-0.19192E+00,-0.18995E+00,-0.18795E+00, + &-0.18591E+00,-0.18384E+00,-0.18174E+00,-0.17961E+00,-0.17744E+00, + &-0.17525E+00,-0.17303E+00,-0.17078E+00,-0.16849E+00,-0.16619E+00, + &-0.16385E+00,-0.16149E+00,-0.15910E+00,-0.15668E+00,-0.15423E+00, + &-0.15176E+00,-0.14927E+00,-0.14675E+00,-0.14420E+00,-0.14163E+00, + &-0.13903E+00,-0.13641E+00,-0.13376E+00,-0.13110E+00,-0.12840E+00, + &-0.12569E+00,-0.12295E+00,-0.12020E+00,-0.11742E+00,-0.11462E+00, + &-0.11180E+00,-0.10896E+00,-0.10610E+00,-0.10322E+00,-0.10033E+00/ + + DATA (BNC09M (I),I=101,200)/ + &-0.97415E-01,-0.94487E-01,-0.91545E-01,-0.88587E-01,-0.85616E-01, + &-0.82631E-01,-0.79634E-01,-0.76626E-01,-0.73606E-01,-0.70577E-01, + &-0.67538E-01,-0.64490E-01,-0.61435E-01,-0.58371E-01,-0.55302E-01, + &-0.52227E-01,-0.49147E-01,-0.46061E-01,-0.42972E-01,-0.39880E-01, + &-0.37062E-01,-0.33933E-01,-0.30805E-01,-0.27679E-01,-0.24555E-01, + &-0.21433E-01,-0.18313E-01,-0.15196E-01,-0.12082E-01,-0.89703E-02, + &-0.58621E-02,-0.27572E-02, 0.34429E-03, 0.34421E-02, 0.65364E-02, + & 0.96264E-02, 0.12713E-01, 0.15795E-01, 0.18873E-01, 0.21946E-01, + & 0.25015E-01, 0.28079E-01, 0.31139E-01, 0.34193E-01, 0.37243E-01, + & 0.40288E-01, 0.43328E-01, 0.46362E-01, 0.49392E-01, 0.52416E-01, + & 0.55435E-01, 0.58448E-01, 0.61456E-01, 0.64458E-01, 0.67455E-01, + & 0.70446E-01, 0.73432E-01, 0.76411E-01, 0.79385E-01, 0.82354E-01, + & 0.85316E-01, 0.88272E-01, 0.91223E-01, 0.94168E-01, 0.97106E-01, + & 0.10004E+00, 0.10297E+00, 0.10589E+00, 0.10880E+00, 0.11171E+00, + & 0.11461E+00, 0.11751E+00, 0.12040E+00, 0.12328E+00, 0.12616E+00, + & 0.12903E+00, 0.13190E+00, 0.13476E+00, 0.13761E+00, 0.14046E+00, + & 0.14330E+00, 0.14614E+00, 0.14896E+00, 0.15179E+00, 0.15460E+00, + & 0.15741E+00, 0.16022E+00, 0.16302E+00, 0.16581E+00, 0.16859E+00, + & 0.17138E+00, 0.17415E+00, 0.17692E+00, 0.17968E+00, 0.18243E+00, + & 0.18518E+00, 0.18793E+00, 0.19066E+00, 0.19340E+00, 0.19612E+00/ + + DATA (BNC09M (I),I=201,300)/ + & 0.19884E+00, 0.20155E+00, 0.20426E+00, 0.20696E+00, 0.20966E+00, + & 0.21235E+00, 0.21503E+00, 0.21771E+00, 0.22038E+00, 0.22305E+00, + & 0.22571E+00, 0.22837E+00, 0.23101E+00, 0.23366E+00, 0.23629E+00, + & 0.23893E+00, 0.24155E+00, 0.24417E+00, 0.24679E+00, 0.24940E+00, + & 0.25200E+00, 0.25460E+00, 0.25719E+00, 0.25978E+00, 0.26236E+00, + & 0.26493E+00, 0.26750E+00, 0.27007E+00, 0.27262E+00, 0.27518E+00, + & 0.27772E+00, 0.28027E+00, 0.28280E+00, 0.28534E+00, 0.28786E+00, + & 0.29038E+00, 0.29290E+00, 0.29541E+00, 0.29791E+00, 0.30041E+00, + & 0.30291E+00, 0.30540E+00, 0.30788E+00, 0.31036E+00, 0.31283E+00, + & 0.31530E+00, 0.31776E+00, 0.32022E+00, 0.32268E+00, 0.32512E+00, + & 0.32757E+00, 0.33000E+00, 0.33244E+00, 0.33486E+00, 0.33729E+00, + & 0.33971E+00, 0.34212E+00, 0.34453E+00, 0.34693E+00, 0.34933E+00, + & 0.35172E+00, 0.35411E+00, 0.35649E+00, 0.35887E+00, 0.36125E+00, + & 0.36362E+00, 0.36598E+00, 0.36834E+00, 0.37070E+00, 0.37305E+00, + & 0.37539E+00, 0.37773E+00, 0.38007E+00, 0.38240E+00, 0.38473E+00, + & 0.38705E+00, 0.38937E+00, 0.39168E+00, 0.39399E+00, 0.39630E+00, + & 0.39860E+00, 0.40089E+00, 0.40318E+00, 0.40547E+00, 0.40775E+00, + & 0.41003E+00, 0.41230E+00, 0.41457E+00, 0.41684E+00, 0.41910E+00, + & 0.42136E+00, 0.42361E+00, 0.42585E+00, 0.42810E+00, 0.43034E+00, + & 0.43257E+00, 0.43480E+00, 0.43703E+00, 0.43925E+00, 0.44147E+00/ + + DATA (BNC09M (I),I=301,400)/ + & 0.44368E+00, 0.44589E+00, 0.44810E+00, 0.45030E+00, 0.45250E+00, + & 0.45469E+00, 0.45688E+00, 0.45906E+00, 0.46124E+00, 0.46342E+00, + & 0.46559E+00, 0.46776E+00, 0.46993E+00, 0.47209E+00, 0.47425E+00, + & 0.47640E+00, 0.47855E+00, 0.48070E+00, 0.48284E+00, 0.48497E+00, + & 0.48711E+00, 0.48924E+00, 0.49136E+00, 0.49349E+00, 0.49561E+00, + & 0.49772E+00, 0.49983E+00, 0.50194E+00, 0.50404E+00, 0.50614E+00, + & 0.50824E+00, 0.51033E+00, 0.51242E+00, 0.51450E+00, 0.51658E+00, + & 0.51866E+00, 0.52074E+00, 0.52281E+00, 0.52487E+00, 0.52694E+00, + & 0.52900E+00, 0.53105E+00, 0.53311E+00, 0.53515E+00, 0.53720E+00, + & 0.53924E+00, 0.54128E+00, 0.54331E+00, 0.54535E+00, 0.54737E+00, + & 0.54940E+00, 0.55142E+00, 0.55344E+00, 0.55545E+00, 0.55746E+00, + & 0.55947E+00, 0.56147E+00, 0.56347E+00, 0.56547E+00, 0.56747E+00, + & 0.56946E+00, 0.57144E+00, 0.57343E+00, 0.57541E+00, 0.57738E+00, + & 0.57936E+00, 0.58133E+00, 0.58330E+00, 0.58526E+00, 0.58722E+00, + & 0.58918E+00, 0.59113E+00, 0.59309E+00, 0.59503E+00, 0.59698E+00, + & 0.59892E+00, 0.60086E+00, 0.60279E+00, 0.60473E+00, 0.60666E+00, + & 0.60858E+00, 0.61050E+00, 0.61242E+00, 0.61434E+00, 0.61625E+00, + & 0.61817E+00, 0.62007E+00, 0.62198E+00, 0.62388E+00, 0.62578E+00, + & 0.62767E+00, 0.62957E+00, 0.63145E+00, 0.63334E+00, 0.63522E+00, + & 0.63710E+00, 0.63898E+00, 0.64086E+00, 0.64273E+00, 0.64460E+00/ + + DATA (BNC09M (I),I=401,500)/ + & 0.64646E+00, 0.64833E+00, 0.65019E+00, 0.65204E+00, 0.65390E+00, + & 0.65575E+00, 0.65760E+00, 0.65944E+00, 0.66128E+00, 0.66312E+00, + & 0.66496E+00, 0.66680E+00, 0.66863E+00, 0.67046E+00, 0.67228E+00, + & 0.67410E+00, 0.67592E+00, 0.67774E+00, 0.67956E+00, 0.68137E+00, + & 0.68318E+00, 0.68498E+00, 0.68679E+00, 0.68859E+00, 0.69039E+00, + & 0.69218E+00, 0.69398E+00, 0.69577E+00, 0.69755E+00, 0.69934E+00, + & 0.70112E+00, 0.70290E+00, 0.70468E+00, 0.70645E+00, 0.70822E+00, + & 0.70999E+00, 0.71176E+00, 0.71352E+00, 0.71528E+00, 0.71704E+00, + & 0.71880E+00, 0.72055E+00, 0.72230E+00, 0.72405E+00, 0.72580E+00, + & 0.72754E+00, 0.72928E+00, 0.73102E+00, 0.73275E+00, 0.73449E+00, + & 0.73622E+00, 0.73794E+00, 0.73967E+00, 0.74139E+00, 0.74311E+00, + & 0.74483E+00, 0.74655E+00, 0.74826E+00, 0.74997E+00, 0.75168E+00, + & 0.75339E+00, 0.75509E+00, 0.75679E+00, 0.75849E+00, 0.76019E+00, + & 0.76188E+00, 0.76357E+00, 0.76526E+00, 0.76695E+00, 0.76863E+00, + & 0.77031E+00, 0.77199E+00, 0.77367E+00, 0.77534E+00, 0.77702E+00, + & 0.77869E+00, 0.78035E+00, 0.78202E+00, 0.78368E+00, 0.78534E+00, + & 0.78700E+00, 0.78866E+00, 0.79031E+00, 0.79197E+00, 0.79362E+00, + & 0.79526E+00, 0.79691E+00, 0.79855E+00, 0.80019E+00, 0.80183E+00, + & 0.80347E+00, 0.80510E+00, 0.80673E+00, 0.80836E+00, 0.80999E+00, + & 0.81161E+00, 0.81323E+00, 0.81486E+00, 0.81647E+00, 0.81809E+00/ + + DATA (BNC09M (I),I=501,600)/ + & 0.81970E+00, 0.82132E+00, 0.82293E+00, 0.82453E+00, 0.82614E+00, + & 0.82774E+00, 0.82934E+00, 0.83094E+00, 0.83254E+00, 0.83413E+00, + & 0.83573E+00, 0.83732E+00, 0.83890E+00, 0.84049E+00, 0.84207E+00, + & 0.84366E+00, 0.84524E+00, 0.84681E+00, 0.84839E+00, 0.84996E+00, + & 0.85154E+00, 0.85311E+00, 0.85467E+00, 0.85624E+00, 0.85780E+00, + & 0.85936E+00, 0.86092E+00, 0.86248E+00, 0.86404E+00, 0.86559E+00, + & 0.86714E+00, 0.86869E+00, 0.87024E+00, 0.87178E+00, 0.87333E+00, + & 0.87487E+00, 0.87641E+00, 0.87795E+00, 0.87948E+00, 0.88101E+00, + & 0.88255E+00, 0.88408E+00, 0.88560E+00, 0.88713E+00, 0.88865E+00, + & 0.89017E+00, 0.89169E+00, 0.89321E+00, 0.89473E+00, 0.89624E+00, + & 0.89776E+00, 0.89927E+00, 0.90077E+00, 0.90228E+00, 0.90379E+00, + & 0.90529E+00, 0.90679E+00, 0.90829E+00, 0.90979E+00, 0.91128E+00, + & 0.91277E+00, 0.91427E+00, 0.91576E+00, 0.91724E+00, 0.91873E+00, + & 0.92021E+00, 0.92170E+00, 0.92318E+00, 0.92466E+00, 0.92613E+00, + & 0.92761E+00, 0.92908E+00, 0.93055E+00, 0.93202E+00, 0.93349E+00, + & 0.93496E+00, 0.93642E+00, 0.93788E+00, 0.93935E+00, 0.94080E+00, + & 0.94226E+00, 0.94372E+00, 0.94517E+00, 0.94662E+00, 0.94807E+00, + & 0.94952E+00, 0.95097E+00, 0.95241E+00, 0.95386E+00, 0.95530E+00, + & 0.95674E+00, 0.95818E+00, 0.95961E+00, 0.96105E+00, 0.96248E+00, + & 0.96391E+00, 0.96534E+00, 0.96677E+00, 0.96820E+00, 0.97353E+00/ + + DATA (BNC09M (I),I=601,700)/ + & 0.98518E+00, 0.99915E+00, 0.10130E+01, 0.10266E+01, 0.10401E+01, + & 0.10535E+01, 0.10667E+01, 0.10797E+01, 0.10927E+01, 0.11054E+01, + & 0.11181E+01, 0.11306E+01, 0.11430E+01, 0.11553E+01, 0.11674E+01, + & 0.11794E+01, 0.11913E+01, 0.12031E+01, 0.12148E+01, 0.12263E+01, + & 0.12378E+01, 0.12491E+01, 0.12604E+01, 0.12715E+01, 0.12825E+01, + & 0.12934E+01, 0.13043E+01, 0.13150E+01, 0.13257E+01, 0.13362E+01, + & 0.13467E+01, 0.13570E+01, 0.13673E+01, 0.13775E+01, 0.13876E+01, + & 0.13976E+01, 0.14075E+01, 0.14174E+01, 0.14272E+01, 0.14369E+01, + & 0.14465E+01, 0.14560E+01, 0.14655E+01, 0.14749E+01, 0.14842E+01, + & 0.14935E+01, 0.15027E+01, 0.15118E+01, 0.15208E+01, 0.15298E+01, + & 0.15387E+01, 0.15476E+01, 0.15563E+01, 0.15651E+01, 0.15737E+01, + & 0.15823E+01, 0.15908E+01, 0.15993E+01, 0.16077E+01, 0.16161E+01, + & 0.16244E+01, 0.16326E+01, 0.16408E+01, 0.16489E+01, 0.16570E+01, + & 0.16650E+01, 0.16730E+01, 0.16809E+01, 0.16888E+01, 0.16966E+01, + & 0.17044E+01, 0.17121E+01, 0.17197E+01, 0.17274E+01, 0.17349E+01, + & 0.17424E+01, 0.17499E+01, 0.17574E+01, 0.17647E+01, 0.17721E+01, + & 0.17794E+01, 0.17866E+01, 0.17938E+01, 0.18010E+01, 0.18081E+01, + & 0.18152E+01, 0.18222E+01, 0.18292E+01, 0.18362E+01, 0.18431E+01, + & 0.18500E+01, 0.18568E+01, 0.18636E+01, 0.18704E+01, 0.18771E+01, + & 0.18838E+01, 0.18905E+01, 0.18971E+01, 0.19037E+01, 0.19102E+01/ + + DATA (BNC09M(I),I=701,741)/ + & 0.19167E+01, 0.19232E+01, 0.19296E+01, 0.19360E+01, 0.19424E+01, + & 0.19488E+01, 0.19551E+01, 0.19613E+01, 0.19676E+01, 0.19738E+01, + & 0.19800E+01, 0.19861E+01, 0.19922E+01, 0.19983E+01, 0.20044E+01, + & 0.20104E+01, 0.20164E+01, 0.20223E+01, 0.20283E+01, 0.20342E+01, + & 0.20401E+01, 0.20459E+01, 0.20517E+01, 0.20575E+01, 0.20633E+01, + & 0.20690E+01, 0.20747E+01, 0.20804E+01, 0.20861E+01, 0.20917E+01, + & 0.20973E+01, 0.21029E+01, 0.21084E+01, 0.21140E+01, 0.21195E+01, + & 0.21249E+01, 0.21304E+01, 0.21358E+01, 0.21412E+01, 0.21466E+01, + & 0.21520E+01 + & / +C +C *** (H, NO3) +C + DATA (BNC10M (I),I= 1,100)/ + &-0.49808E-01,-0.87670E-01,-0.11206E+00,-0.12725E+00,-0.13801E+00, + &-0.14607E+00,-0.15233E+00,-0.15727E+00,-0.16121E+00,-0.16437E+00, + &-0.16689E+00,-0.16889E+00,-0.17045E+00,-0.17164E+00,-0.17251E+00, + &-0.17311E+00,-0.17346E+00,-0.17359E+00,-0.17354E+00,-0.17332E+00, + &-0.17295E+00,-0.17244E+00,-0.17181E+00,-0.17107E+00,-0.17023E+00, + &-0.16931E+00,-0.16829E+00,-0.16721E+00,-0.16605E+00,-0.16483E+00, + &-0.16356E+00,-0.16223E+00,-0.16086E+00,-0.15944E+00,-0.15798E+00, + &-0.15649E+00,-0.15496E+00,-0.15340E+00,-0.15182E+00,-0.15021E+00, + &-0.14858E+00,-0.14693E+00,-0.14526E+00,-0.14357E+00,-0.14187E+00, + &-0.14015E+00,-0.13842E+00,-0.13668E+00,-0.13493E+00,-0.13316E+00, + &-0.13139E+00,-0.12961E+00,-0.12783E+00,-0.12603E+00,-0.12423E+00, + &-0.12243E+00,-0.12061E+00,-0.11880E+00,-0.11697E+00,-0.11514E+00, + &-0.11330E+00,-0.11146E+00,-0.10961E+00,-0.10776E+00,-0.10590E+00, + &-0.10403E+00,-0.10215E+00,-0.10027E+00,-0.98377E-01,-0.96477E-01, + &-0.94568E-01,-0.92650E-01,-0.90723E-01,-0.88785E-01,-0.86836E-01, + &-0.84877E-01,-0.82906E-01,-0.80923E-01,-0.78927E-01,-0.76919E-01, + &-0.74899E-01,-0.72864E-01,-0.70817E-01,-0.68755E-01,-0.66679E-01, + &-0.64590E-01,-0.62485E-01,-0.60367E-01,-0.58234E-01,-0.56087E-01, + &-0.53925E-01,-0.51749E-01,-0.49559E-01,-0.47354E-01,-0.45136E-01, + &-0.42905E-01,-0.40659E-01,-0.38401E-01,-0.36131E-01,-0.33847E-01/ + + DATA (BNC10M (I),I=101,200)/ + &-0.31552E-01,-0.29246E-01,-0.26928E-01,-0.24599E-01,-0.22261E-01, + &-0.19912E-01,-0.17554E-01,-0.15187E-01,-0.12812E-01,-0.10429E-01, + &-0.80390E-02,-0.56417E-02,-0.32380E-02,-0.82822E-03, 0.15871E-02, + & 0.40074E-02, 0.64324E-02, 0.88617E-02, 0.11295E-01, 0.13731E-01, + & 0.15915E-01, 0.18387E-01, 0.20858E-01, 0.23329E-01, 0.25799E-01, + & 0.28268E-01, 0.30736E-01, 0.33203E-01, 0.35669E-01, 0.38134E-01, + & 0.40598E-01, 0.43060E-01, 0.45521E-01, 0.47981E-01, 0.50440E-01, + & 0.52896E-01, 0.55352E-01, 0.57806E-01, 0.60258E-01, 0.62708E-01, + & 0.65157E-01, 0.67604E-01, 0.70049E-01, 0.72492E-01, 0.74934E-01, + & 0.77373E-01, 0.79810E-01, 0.82246E-01, 0.84679E-01, 0.87110E-01, + & 0.89539E-01, 0.91966E-01, 0.94390E-01, 0.96812E-01, 0.99232E-01, + & 0.10165E+00, 0.10407E+00, 0.10648E+00, 0.10889E+00, 0.11130E+00, + & 0.11370E+00, 0.11611E+00, 0.11851E+00, 0.12090E+00, 0.12330E+00, + & 0.12569E+00, 0.12808E+00, 0.13047E+00, 0.13285E+00, 0.13524E+00, + & 0.13762E+00, 0.13999E+00, 0.14237E+00, 0.14474E+00, 0.14711E+00, + & 0.14947E+00, 0.15183E+00, 0.15419E+00, 0.15655E+00, 0.15891E+00, + & 0.16126E+00, 0.16361E+00, 0.16595E+00, 0.16829E+00, 0.17063E+00, + & 0.17297E+00, 0.17530E+00, 0.17764E+00, 0.17996E+00, 0.18229E+00, + & 0.18461E+00, 0.18693E+00, 0.18924E+00, 0.19156E+00, 0.19387E+00, + & 0.19617E+00, 0.19848E+00, 0.20078E+00, 0.20308E+00, 0.20537E+00/ + + DATA (BNC10M (I),I=201,300)/ + & 0.20766E+00, 0.20995E+00, 0.21223E+00, 0.21452E+00, 0.21680E+00, + & 0.21907E+00, 0.22134E+00, 0.22361E+00, 0.22588E+00, 0.22814E+00, + & 0.23040E+00, 0.23266E+00, 0.23491E+00, 0.23717E+00, 0.23941E+00, + & 0.24166E+00, 0.24390E+00, 0.24614E+00, 0.24837E+00, 0.25060E+00, + & 0.25283E+00, 0.25506E+00, 0.25728E+00, 0.25950E+00, 0.26171E+00, + & 0.26393E+00, 0.26614E+00, 0.26834E+00, 0.27054E+00, 0.27274E+00, + & 0.27494E+00, 0.27713E+00, 0.27933E+00, 0.28151E+00, 0.28370E+00, + & 0.28588E+00, 0.28805E+00, 0.29023E+00, 0.29240E+00, 0.29457E+00, + & 0.29673E+00, 0.29890E+00, 0.30105E+00, 0.30321E+00, 0.30536E+00, + & 0.30751E+00, 0.30966E+00, 0.31180E+00, 0.31394E+00, 0.31607E+00, + & 0.31821E+00, 0.32034E+00, 0.32247E+00, 0.32459E+00, 0.32671E+00, + & 0.32883E+00, 0.33094E+00, 0.33305E+00, 0.33516E+00, 0.33727E+00, + & 0.33937E+00, 0.34147E+00, 0.34356E+00, 0.34565E+00, 0.34774E+00, + & 0.34983E+00, 0.35191E+00, 0.35399E+00, 0.35607E+00, 0.35814E+00, + & 0.36021E+00, 0.36228E+00, 0.36435E+00, 0.36641E+00, 0.36847E+00, + & 0.37052E+00, 0.37257E+00, 0.37462E+00, 0.37667E+00, 0.37871E+00, + & 0.38075E+00, 0.38279E+00, 0.38482E+00, 0.38685E+00, 0.38888E+00, + & 0.39091E+00, 0.39293E+00, 0.39495E+00, 0.39696E+00, 0.39898E+00, + & 0.40099E+00, 0.40299E+00, 0.40500E+00, 0.40700E+00, 0.40899E+00, + & 0.41099E+00, 0.41298E+00, 0.41497E+00, 0.41696E+00, 0.41894E+00/ + + DATA (BNC10M (I),I=301,400)/ + & 0.42092E+00, 0.42290E+00, 0.42487E+00, 0.42684E+00, 0.42881E+00, + & 0.43077E+00, 0.43274E+00, 0.43470E+00, 0.43665E+00, 0.43861E+00, + & 0.44056E+00, 0.44251E+00, 0.44445E+00, 0.44639E+00, 0.44833E+00, + & 0.45027E+00, 0.45220E+00, 0.45413E+00, 0.45606E+00, 0.45798E+00, + & 0.45991E+00, 0.46183E+00, 0.46374E+00, 0.46566E+00, 0.46757E+00, + & 0.46947E+00, 0.47138E+00, 0.47328E+00, 0.47518E+00, 0.47708E+00, + & 0.47897E+00, 0.48086E+00, 0.48275E+00, 0.48464E+00, 0.48652E+00, + & 0.48840E+00, 0.49028E+00, 0.49215E+00, 0.49402E+00, 0.49589E+00, + & 0.49776E+00, 0.49962E+00, 0.50148E+00, 0.50334E+00, 0.50520E+00, + & 0.50705E+00, 0.50890E+00, 0.51075E+00, 0.51259E+00, 0.51443E+00, + & 0.51627E+00, 0.51811E+00, 0.51994E+00, 0.52178E+00, 0.52360E+00, + & 0.52543E+00, 0.52725E+00, 0.52907E+00, 0.53089E+00, 0.53271E+00, + & 0.53452E+00, 0.53633E+00, 0.53814E+00, 0.53994E+00, 0.54175E+00, + & 0.54355E+00, 0.54534E+00, 0.54714E+00, 0.54893E+00, 0.55072E+00, + & 0.55251E+00, 0.55429E+00, 0.55607E+00, 0.55785E+00, 0.55963E+00, + & 0.56140E+00, 0.56318E+00, 0.56495E+00, 0.56671E+00, 0.56848E+00, + & 0.57024E+00, 0.57200E+00, 0.57375E+00, 0.57551E+00, 0.57726E+00, + & 0.57901E+00, 0.58076E+00, 0.58250E+00, 0.58424E+00, 0.58598E+00, + & 0.58772E+00, 0.58945E+00, 0.59119E+00, 0.59292E+00, 0.59464E+00, + & 0.59637E+00, 0.59809E+00, 0.59981E+00, 0.60153E+00, 0.60324E+00/ + + DATA (BNC10M (I),I=401,500)/ + & 0.60496E+00, 0.60667E+00, 0.60838E+00, 0.61008E+00, 0.61178E+00, + & 0.61349E+00, 0.61518E+00, 0.61688E+00, 0.61857E+00, 0.62027E+00, + & 0.62196E+00, 0.62364E+00, 0.62533E+00, 0.62701E+00, 0.62869E+00, + & 0.63037E+00, 0.63204E+00, 0.63372E+00, 0.63539E+00, 0.63705E+00, + & 0.63872E+00, 0.64039E+00, 0.64205E+00, 0.64371E+00, 0.64536E+00, + & 0.64702E+00, 0.64867E+00, 0.65032E+00, 0.65197E+00, 0.65362E+00, + & 0.65526E+00, 0.65690E+00, 0.65854E+00, 0.66018E+00, 0.66181E+00, + & 0.66344E+00, 0.66507E+00, 0.66670E+00, 0.66833E+00, 0.66995E+00, + & 0.67157E+00, 0.67319E+00, 0.67481E+00, 0.67643E+00, 0.67804E+00, + & 0.67965E+00, 0.68126E+00, 0.68286E+00, 0.68447E+00, 0.68607E+00, + & 0.68767E+00, 0.68927E+00, 0.69086E+00, 0.69246E+00, 0.69405E+00, + & 0.69564E+00, 0.69723E+00, 0.69881E+00, 0.70040E+00, 0.70198E+00, + & 0.70356E+00, 0.70513E+00, 0.70671E+00, 0.70828E+00, 0.70985E+00, + & 0.71142E+00, 0.71299E+00, 0.71455E+00, 0.71611E+00, 0.71767E+00, + & 0.71923E+00, 0.72079E+00, 0.72234E+00, 0.72390E+00, 0.72545E+00, + & 0.72699E+00, 0.72854E+00, 0.73008E+00, 0.73163E+00, 0.73317E+00, + & 0.73471E+00, 0.73624E+00, 0.73778E+00, 0.73931E+00, 0.74084E+00, + & 0.74237E+00, 0.74389E+00, 0.74542E+00, 0.74694E+00, 0.74846E+00, + & 0.74998E+00, 0.75150E+00, 0.75301E+00, 0.75453E+00, 0.75604E+00, + & 0.75755E+00, 0.75905E+00, 0.76056E+00, 0.76206E+00, 0.76356E+00/ + + DATA (BNC10M (I),I=501,600)/ + & 0.76506E+00, 0.76656E+00, 0.76806E+00, 0.76955E+00, 0.77104E+00, + & 0.77253E+00, 0.77402E+00, 0.77551E+00, 0.77699E+00, 0.77847E+00, + & 0.77995E+00, 0.78143E+00, 0.78291E+00, 0.78439E+00, 0.78586E+00, + & 0.78733E+00, 0.78880E+00, 0.79027E+00, 0.79173E+00, 0.79320E+00, + & 0.79466E+00, 0.79612E+00, 0.79758E+00, 0.79904E+00, 0.80049E+00, + & 0.80195E+00, 0.80340E+00, 0.80485E+00, 0.80630E+00, 0.80774E+00, + & 0.80919E+00, 0.81063E+00, 0.81207E+00, 0.81351E+00, 0.81495E+00, + & 0.81638E+00, 0.81782E+00, 0.81925E+00, 0.82068E+00, 0.82211E+00, + & 0.82353E+00, 0.82496E+00, 0.82638E+00, 0.82780E+00, 0.82923E+00, + & 0.83064E+00, 0.83206E+00, 0.83347E+00, 0.83489E+00, 0.83630E+00, + & 0.83771E+00, 0.83912E+00, 0.84052E+00, 0.84193E+00, 0.84333E+00, + & 0.84473E+00, 0.84613E+00, 0.84753E+00, 0.84893E+00, 0.85032E+00, + & 0.85171E+00, 0.85311E+00, 0.85450E+00, 0.85588E+00, 0.85727E+00, + & 0.85866E+00, 0.86004E+00, 0.86142E+00, 0.86280E+00, 0.86418E+00, + & 0.86555E+00, 0.86693E+00, 0.86830E+00, 0.86968E+00, 0.87105E+00, + & 0.87241E+00, 0.87378E+00, 0.87515E+00, 0.87651E+00, 0.87787E+00, + & 0.87923E+00, 0.88059E+00, 0.88195E+00, 0.88330E+00, 0.88466E+00, + & 0.88601E+00, 0.88736E+00, 0.88871E+00, 0.89006E+00, 0.89141E+00, + & 0.89275E+00, 0.89410E+00, 0.89544E+00, 0.89678E+00, 0.89812E+00, + & 0.89945E+00, 0.90079E+00, 0.90212E+00, 0.90346E+00, 0.90844E+00/ + + DATA (BNC10M (I),I=601,700)/ + & 0.91933E+00, 0.93239E+00, 0.94531E+00, 0.95808E+00, 0.97072E+00, + & 0.98322E+00, 0.99558E+00, 0.10078E+01, 0.10199E+01, 0.10319E+01, + & 0.10438E+01, 0.10555E+01, 0.10671E+01, 0.10786E+01, 0.10900E+01, + & 0.11013E+01, 0.11124E+01, 0.11235E+01, 0.11344E+01, 0.11453E+01, + & 0.11560E+01, 0.11666E+01, 0.11772E+01, 0.11876E+01, 0.11980E+01, + & 0.12082E+01, 0.12184E+01, 0.12285E+01, 0.12385E+01, 0.12484E+01, + & 0.12582E+01, 0.12679E+01, 0.12776E+01, 0.12871E+01, 0.12966E+01, + & 0.13060E+01, 0.13154E+01, 0.13246E+01, 0.13338E+01, 0.13429E+01, + & 0.13519E+01, 0.13609E+01, 0.13698E+01, 0.13786E+01, 0.13874E+01, + & 0.13960E+01, 0.14047E+01, 0.14132E+01, 0.14217E+01, 0.14301E+01, + & 0.14385E+01, 0.14468E+01, 0.14550E+01, 0.14632E+01, 0.14713E+01, + & 0.14794E+01, 0.14874E+01, 0.14954E+01, 0.15033E+01, 0.15111E+01, + & 0.15189E+01, 0.15266E+01, 0.15343E+01, 0.15419E+01, 0.15495E+01, + & 0.15570E+01, 0.15645E+01, 0.15719E+01, 0.15793E+01, 0.15866E+01, + & 0.15939E+01, 0.16012E+01, 0.16084E+01, 0.16155E+01, 0.16226E+01, + & 0.16297E+01, 0.16367E+01, 0.16436E+01, 0.16506E+01, 0.16574E+01, + & 0.16643E+01, 0.16711E+01, 0.16778E+01, 0.16845E+01, 0.16912E+01, + & 0.16979E+01, 0.17045E+01, 0.17110E+01, 0.17175E+01, 0.17240E+01, + & 0.17305E+01, 0.17369E+01, 0.17433E+01, 0.17496E+01, 0.17559E+01, + & 0.17622E+01, 0.17684E+01, 0.17746E+01, 0.17808E+01, 0.17869E+01/ + + DATA (BNC10M(I),I=701,741)/ + & 0.17930E+01, 0.17991E+01, 0.18051E+01, 0.18111E+01, 0.18171E+01, + & 0.18230E+01, 0.18289E+01, 0.18348E+01, 0.18406E+01, 0.18464E+01, + & 0.18522E+01, 0.18580E+01, 0.18637E+01, 0.18694E+01, 0.18751E+01, + & 0.18807E+01, 0.18863E+01, 0.18919E+01, 0.18974E+01, 0.19030E+01, + & 0.19085E+01, 0.19139E+01, 0.19194E+01, 0.19248E+01, 0.19302E+01, + & 0.19356E+01, 0.19409E+01, 0.19462E+01, 0.19515E+01, 0.19568E+01, + & 0.19620E+01, 0.19672E+01, 0.19724E+01, 0.19776E+01, 0.19828E+01, + & 0.19879E+01, 0.19930E+01, 0.19981E+01, 0.20031E+01, 0.20081E+01, + & 0.20131E+01 + & / +C +C *** (H, Cl) +C + DATA (BNC11M (I),I= 1,100)/ + &-0.48532E-01,-0.83296E-01,-0.10417E+00,-0.11618E+00,-0.12392E+00, + &-0.12909E+00,-0.13252E+00,-0.13467E+00,-0.13584E+00,-0.13624E+00, + &-0.13600E+00,-0.13524E+00,-0.13402E+00,-0.13242E+00,-0.13047E+00, + &-0.12822E+00,-0.12570E+00,-0.12295E+00,-0.11997E+00,-0.11680E+00, + &-0.11344E+00,-0.10992E+00,-0.10625E+00,-0.10244E+00,-0.98493E-01, + &-0.94429E-01,-0.90252E-01,-0.85971E-01,-0.81593E-01,-0.77125E-01, + &-0.72571E-01,-0.67939E-01,-0.63234E-01,-0.58460E-01,-0.53621E-01, + &-0.48723E-01,-0.43768E-01,-0.38762E-01,-0.33706E-01,-0.28606E-01, + &-0.23462E-01,-0.18280E-01,-0.13061E-01,-0.78068E-02,-0.25211E-02, + & 0.27943E-02, 0.81376E-02, 0.13507E-01, 0.18900E-01, 0.24317E-01, + & 0.29754E-01, 0.35212E-01, 0.40689E-01, 0.46183E-01, 0.51695E-01, + & 0.57224E-01, 0.62769E-01, 0.68329E-01, 0.73904E-01, 0.79495E-01, + & 0.85100E-01, 0.90721E-01, 0.96357E-01, 0.10201E+00, 0.10768E+00, + & 0.11336E+00, 0.11906E+00, 0.12478E+00, 0.13051E+00, 0.13627E+00, + & 0.14204E+00, 0.14783E+00, 0.15365E+00, 0.15948E+00, 0.16534E+00, + & 0.17123E+00, 0.17713E+00, 0.18307E+00, 0.18902E+00, 0.19501E+00, + & 0.20102E+00, 0.20706E+00, 0.21313E+00, 0.21923E+00, 0.22536E+00, + & 0.23151E+00, 0.23770E+00, 0.24392E+00, 0.25017E+00, 0.25645E+00, + & 0.26276E+00, 0.26910E+00, 0.27546E+00, 0.28186E+00, 0.28829E+00, + & 0.29475E+00, 0.30123E+00, 0.30774E+00, 0.31428E+00, 0.32084E+00/ + + DATA (BNC11M (I),I=101,200)/ + & 0.32743E+00, 0.33404E+00, 0.34068E+00, 0.34734E+00, 0.35401E+00, + & 0.36071E+00, 0.36742E+00, 0.37415E+00, 0.38090E+00, 0.38766E+00, + & 0.39444E+00, 0.40123E+00, 0.40803E+00, 0.41484E+00, 0.42166E+00, + & 0.42848E+00, 0.43532E+00, 0.44216E+00, 0.44900E+00, 0.45585E+00, + & 0.46211E+00, 0.46904E+00, 0.47595E+00, 0.48286E+00, 0.48977E+00, + & 0.49667E+00, 0.50356E+00, 0.51044E+00, 0.51732E+00, 0.52419E+00, + & 0.53105E+00, 0.53791E+00, 0.54476E+00, 0.55160E+00, 0.55843E+00, + & 0.56525E+00, 0.57207E+00, 0.57887E+00, 0.58567E+00, 0.59246E+00, + & 0.59924E+00, 0.60601E+00, 0.61277E+00, 0.61952E+00, 0.62627E+00, + & 0.63300E+00, 0.63972E+00, 0.64643E+00, 0.65314E+00, 0.65983E+00, + & 0.66651E+00, 0.67319E+00, 0.67985E+00, 0.68650E+00, 0.69314E+00, + & 0.69977E+00, 0.70639E+00, 0.71300E+00, 0.71960E+00, 0.72618E+00, + & 0.73276E+00, 0.73933E+00, 0.74588E+00, 0.75242E+00, 0.75896E+00, + & 0.76548E+00, 0.77198E+00, 0.77848E+00, 0.78497E+00, 0.79144E+00, + & 0.79791E+00, 0.80436E+00, 0.81080E+00, 0.81723E+00, 0.82365E+00, + & 0.83005E+00, 0.83645E+00, 0.84283E+00, 0.84920E+00, 0.85556E+00, + & 0.86191E+00, 0.86824E+00, 0.87457E+00, 0.88088E+00, 0.88718E+00, + & 0.89347E+00, 0.89975E+00, 0.90601E+00, 0.91226E+00, 0.91851E+00, + & 0.92473E+00, 0.93095E+00, 0.93716E+00, 0.94335E+00, 0.94953E+00, + & 0.95570E+00, 0.96186E+00, 0.96801E+00, 0.97414E+00, 0.98027E+00/ + + DATA (BNC11M (I),I=201,300)/ + & 0.98638E+00, 0.99248E+00, 0.99857E+00, 0.10046E+01, 0.10107E+01, + & 0.10168E+01, 0.10228E+01, 0.10288E+01, 0.10348E+01, 0.10408E+01, + & 0.10468E+01, 0.10528E+01, 0.10588E+01, 0.10648E+01, 0.10707E+01, + & 0.10766E+01, 0.10826E+01, 0.10885E+01, 0.10944E+01, 0.11003E+01, + & 0.11061E+01, 0.11120E+01, 0.11179E+01, 0.11237E+01, 0.11295E+01, + & 0.11354E+01, 0.11412E+01, 0.11470E+01, 0.11527E+01, 0.11585E+01, + & 0.11643E+01, 0.11700E+01, 0.11758E+01, 0.11815E+01, 0.11872E+01, + & 0.11929E+01, 0.11986E+01, 0.12043E+01, 0.12100E+01, 0.12156E+01, + & 0.12213E+01, 0.12269E+01, 0.12326E+01, 0.12382E+01, 0.12438E+01, + & 0.12494E+01, 0.12550E+01, 0.12605E+01, 0.12661E+01, 0.12717E+01, + & 0.12772E+01, 0.12827E+01, 0.12883E+01, 0.12938E+01, 0.12993E+01, + & 0.13048E+01, 0.13102E+01, 0.13157E+01, 0.13212E+01, 0.13266E+01, + & 0.13320E+01, 0.13375E+01, 0.13429E+01, 0.13483E+01, 0.13537E+01, + & 0.13591E+01, 0.13644E+01, 0.13698E+01, 0.13752E+01, 0.13805E+01, + & 0.13858E+01, 0.13912E+01, 0.13965E+01, 0.14018E+01, 0.14071E+01, + & 0.14123E+01, 0.14176E+01, 0.14229E+01, 0.14281E+01, 0.14334E+01, + & 0.14386E+01, 0.14438E+01, 0.14490E+01, 0.14542E+01, 0.14594E+01, + & 0.14646E+01, 0.14698E+01, 0.14749E+01, 0.14801E+01, 0.14852E+01, + & 0.14904E+01, 0.14955E+01, 0.15006E+01, 0.15057E+01, 0.15108E+01, + & 0.15159E+01, 0.15210E+01, 0.15260E+01, 0.15311E+01, 0.15362E+01/ + + DATA (BNC11M (I),I=301,400)/ + & 0.15412E+01, 0.15462E+01, 0.15512E+01, 0.15563E+01, 0.15613E+01, + & 0.15663E+01, 0.15712E+01, 0.15762E+01, 0.15812E+01, 0.15861E+01, + & 0.15911E+01, 0.15960E+01, 0.16010E+01, 0.16059E+01, 0.16108E+01, + & 0.16157E+01, 0.16206E+01, 0.16255E+01, 0.16303E+01, 0.16352E+01, + & 0.16401E+01, 0.16449E+01, 0.16498E+01, 0.16546E+01, 0.16594E+01, + & 0.16642E+01, 0.16690E+01, 0.16738E+01, 0.16786E+01, 0.16834E+01, + & 0.16882E+01, 0.16930E+01, 0.16977E+01, 0.17025E+01, 0.17072E+01, + & 0.17119E+01, 0.17167E+01, 0.17214E+01, 0.17261E+01, 0.17308E+01, + & 0.17355E+01, 0.17401E+01, 0.17448E+01, 0.17495E+01, 0.17541E+01, + & 0.17588E+01, 0.17634E+01, 0.17681E+01, 0.17727E+01, 0.17773E+01, + & 0.17819E+01, 0.17865E+01, 0.17911E+01, 0.17957E+01, 0.18003E+01, + & 0.18048E+01, 0.18094E+01, 0.18139E+01, 0.18185E+01, 0.18230E+01, + & 0.18276E+01, 0.18321E+01, 0.18366E+01, 0.18411E+01, 0.18456E+01, + & 0.18501E+01, 0.18546E+01, 0.18591E+01, 0.18635E+01, 0.18680E+01, + & 0.18724E+01, 0.18769E+01, 0.18813E+01, 0.18858E+01, 0.18902E+01, + & 0.18946E+01, 0.18990E+01, 0.19034E+01, 0.19078E+01, 0.19122E+01, + & 0.19166E+01, 0.19210E+01, 0.19253E+01, 0.19297E+01, 0.19340E+01, + & 0.19384E+01, 0.19427E+01, 0.19471E+01, 0.19514E+01, 0.19557E+01, + & 0.19600E+01, 0.19643E+01, 0.19686E+01, 0.19729E+01, 0.19772E+01, + & 0.19814E+01, 0.19857E+01, 0.19900E+01, 0.19942E+01, 0.19985E+01/ + + DATA (BNC11M (I),I=401,500)/ + & 0.20027E+01, 0.20069E+01, 0.20112E+01, 0.20154E+01, 0.20196E+01, + & 0.20238E+01, 0.20280E+01, 0.20322E+01, 0.20364E+01, 0.20406E+01, + & 0.20447E+01, 0.20489E+01, 0.20531E+01, 0.20572E+01, 0.20614E+01, + & 0.20655E+01, 0.20697E+01, 0.20738E+01, 0.20779E+01, 0.20820E+01, + & 0.20861E+01, 0.20902E+01, 0.20943E+01, 0.20984E+01, 0.21025E+01, + & 0.21066E+01, 0.21106E+01, 0.21147E+01, 0.21188E+01, 0.21228E+01, + & 0.21269E+01, 0.21309E+01, 0.21349E+01, 0.21390E+01, 0.21430E+01, + & 0.21470E+01, 0.21510E+01, 0.21550E+01, 0.21590E+01, 0.21630E+01, + & 0.21670E+01, 0.21709E+01, 0.21749E+01, 0.21789E+01, 0.21828E+01, + & 0.21868E+01, 0.21907E+01, 0.21947E+01, 0.21986E+01, 0.22026E+01, + & 0.22065E+01, 0.22104E+01, 0.22143E+01, 0.22182E+01, 0.22221E+01, + & 0.22260E+01, 0.22299E+01, 0.22338E+01, 0.22377E+01, 0.22415E+01, + & 0.22454E+01, 0.22493E+01, 0.22531E+01, 0.22570E+01, 0.22608E+01, + & 0.22646E+01, 0.22685E+01, 0.22723E+01, 0.22761E+01, 0.22799E+01, + & 0.22838E+01, 0.22876E+01, 0.22914E+01, 0.22951E+01, 0.22989E+01, + & 0.23027E+01, 0.23065E+01, 0.23103E+01, 0.23140E+01, 0.23178E+01, + & 0.23215E+01, 0.23253E+01, 0.23290E+01, 0.23328E+01, 0.23365E+01, + & 0.23402E+01, 0.23440E+01, 0.23477E+01, 0.23514E+01, 0.23551E+01, + & 0.23588E+01, 0.23625E+01, 0.23662E+01, 0.23699E+01, 0.23736E+01, + & 0.23772E+01, 0.23809E+01, 0.23846E+01, 0.23882E+01, 0.23919E+01/ + + DATA (BNC11M (I),I=501,600)/ + & 0.23955E+01, 0.23992E+01, 0.24028E+01, 0.24065E+01, 0.24101E+01, + & 0.24137E+01, 0.24173E+01, 0.24210E+01, 0.24246E+01, 0.24282E+01, + & 0.24318E+01, 0.24354E+01, 0.24390E+01, 0.24425E+01, 0.24461E+01, + & 0.24497E+01, 0.24533E+01, 0.24568E+01, 0.24604E+01, 0.24640E+01, + & 0.24675E+01, 0.24711E+01, 0.24746E+01, 0.24781E+01, 0.24817E+01, + & 0.24852E+01, 0.24887E+01, 0.24922E+01, 0.24957E+01, 0.24993E+01, + & 0.25028E+01, 0.25063E+01, 0.25097E+01, 0.25132E+01, 0.25167E+01, + & 0.25202E+01, 0.25237E+01, 0.25272E+01, 0.25306E+01, 0.25341E+01, + & 0.25375E+01, 0.25410E+01, 0.25444E+01, 0.25479E+01, 0.25513E+01, + & 0.25548E+01, 0.25582E+01, 0.25616E+01, 0.25650E+01, 0.25684E+01, + & 0.25719E+01, 0.25753E+01, 0.25787E+01, 0.25821E+01, 0.25855E+01, + & 0.25889E+01, 0.25922E+01, 0.25956E+01, 0.25990E+01, 0.26024E+01, + & 0.26057E+01, 0.26091E+01, 0.26125E+01, 0.26158E+01, 0.26192E+01, + & 0.26225E+01, 0.26258E+01, 0.26292E+01, 0.26325E+01, 0.26358E+01, + & 0.26392E+01, 0.26425E+01, 0.26458E+01, 0.26491E+01, 0.26524E+01, + & 0.26557E+01, 0.26590E+01, 0.26623E+01, 0.26656E+01, 0.26689E+01, + & 0.26722E+01, 0.26755E+01, 0.26787E+01, 0.26820E+01, 0.26853E+01, + & 0.26885E+01, 0.26918E+01, 0.26951E+01, 0.26983E+01, 0.27016E+01, + & 0.27048E+01, 0.27080E+01, 0.27113E+01, 0.27145E+01, 0.27177E+01, + & 0.27209E+01, 0.27242E+01, 0.27274E+01, 0.27306E+01, 0.27426E+01/ + + DATA (BNC11M (I),I=601,700)/ + & 0.27688E+01, 0.28002E+01, 0.28313E+01, 0.28620E+01, 0.28923E+01, + & 0.29223E+01, 0.29519E+01, 0.29812E+01, 0.30102E+01, 0.30388E+01, + & 0.30672E+01, 0.30952E+01, 0.31229E+01, 0.31504E+01, 0.31775E+01, + & 0.32044E+01, 0.32310E+01, 0.32573E+01, 0.32834E+01, 0.33092E+01, + & 0.33347E+01, 0.33601E+01, 0.33851E+01, 0.34099E+01, 0.34345E+01, + & 0.34589E+01, 0.34830E+01, 0.35069E+01, 0.35306E+01, 0.35541E+01, + & 0.35773E+01, 0.36004E+01, 0.36232E+01, 0.36459E+01, 0.36683E+01, + & 0.36906E+01, 0.37127E+01, 0.37346E+01, 0.37563E+01, 0.37778E+01, + & 0.37992E+01, 0.38203E+01, 0.38413E+01, 0.38622E+01, 0.38828E+01, + & 0.39033E+01, 0.39237E+01, 0.39439E+01, 0.39639E+01, 0.39838E+01, + & 0.40035E+01, 0.40231E+01, 0.40425E+01, 0.40618E+01, 0.40809E+01, + & 0.40999E+01, 0.41188E+01, 0.41375E+01, 0.41561E+01, 0.41746E+01, + & 0.41929E+01, 0.42111E+01, 0.42292E+01, 0.42472E+01, 0.42650E+01, + & 0.42827E+01, 0.43003E+01, 0.43177E+01, 0.43351E+01, 0.43523E+01, + & 0.43695E+01, 0.43865E+01, 0.44034E+01, 0.44202E+01, 0.44368E+01, + & 0.44534E+01, 0.44699E+01, 0.44862E+01, 0.45025E+01, 0.45187E+01, + & 0.45347E+01, 0.45507E+01, 0.45666E+01, 0.45823E+01, 0.45980E+01, + & 0.46136E+01, 0.46291E+01, 0.46445E+01, 0.46598E+01, 0.46750E+01, + & 0.46901E+01, 0.47051E+01, 0.47201E+01, 0.47350E+01, 0.47497E+01, + & 0.47644E+01, 0.47791E+01, 0.47936E+01, 0.48080E+01, 0.48224E+01/ + + DATA (BNC11M(I),I=701,741)/ + & 0.48367E+01, 0.48509E+01, 0.48651E+01, 0.48791E+01, 0.48931E+01, + & 0.49070E+01, 0.49208E+01, 0.49346E+01, 0.49483E+01, 0.49619E+01, + & 0.49755E+01, 0.49889E+01, 0.50023E+01, 0.50157E+01, 0.50290E+01, + & 0.50422E+01, 0.50553E+01, 0.50684E+01, 0.50814E+01, 0.50943E+01, + & 0.51072E+01, 0.51200E+01, 0.51327E+01, 0.51454E+01, 0.51580E+01, + & 0.51706E+01, 0.51831E+01, 0.51956E+01, 0.52079E+01, 0.52203E+01, + & 0.52325E+01, 0.52447E+01, 0.52569E+01, 0.52690E+01, 0.52810E+01, + & 0.52930E+01, 0.53049E+01, 0.53168E+01, 0.53286E+01, 0.53404E+01, + & 0.53521E+01 + & / +C +C *** NaHSO4 +C + DATA (BNC12M (I),I= 1,100)/ + &-0.49644E-01,-0.87391E-01,-0.11193E+00,-0.12742E+00,-0.13854E+00, + &-0.14701E+00,-0.15369E+00,-0.15906E+00,-0.16342E+00,-0.16698E+00, + &-0.16989E+00,-0.17226E+00,-0.17416E+00,-0.17565E+00,-0.17680E+00, + &-0.17763E+00,-0.17818E+00,-0.17848E+00,-0.17855E+00,-0.17840E+00, + &-0.17807E+00,-0.17755E+00,-0.17687E+00,-0.17603E+00,-0.17505E+00, + &-0.17393E+00,-0.17268E+00,-0.17131E+00,-0.16982E+00,-0.16823E+00, + &-0.16653E+00,-0.16473E+00,-0.16284E+00,-0.16086E+00,-0.15879E+00, + &-0.15664E+00,-0.15441E+00,-0.15211E+00,-0.14974E+00,-0.14729E+00, + &-0.14479E+00,-0.14222E+00,-0.13959E+00,-0.13690E+00,-0.13415E+00, + &-0.13136E+00,-0.12851E+00,-0.12561E+00,-0.12267E+00,-0.11968E+00, + &-0.11665E+00,-0.11358E+00,-0.11046E+00,-0.10731E+00,-0.10412E+00, + &-0.10089E+00,-0.97629E-01,-0.94332E-01,-0.91002E-01,-0.87640E-01, + &-0.84246E-01,-0.80821E-01,-0.77366E-01,-0.73882E-01,-0.70367E-01, + &-0.66825E-01,-0.63253E-01,-0.59653E-01,-0.56026E-01,-0.52370E-01, + &-0.48687E-01,-0.44975E-01,-0.41237E-01,-0.37470E-01,-0.33676E-01, + &-0.29854E-01,-0.26004E-01,-0.22127E-01,-0.18221E-01,-0.14288E-01, + &-0.10326E-01,-0.63369E-02,-0.23194E-02, 0.17259E-02, 0.57993E-02, + & 0.99002E-02, 0.14029E-01, 0.18185E-01, 0.22368E-01, 0.26578E-01, + & 0.30815E-01, 0.35078E-01, 0.39366E-01, 0.43679E-01, 0.48017E-01, + & 0.52379E-01, 0.56764E-01, 0.61172E-01, 0.65602E-01, 0.70053E-01/ + + DATA (BNC12M (I),I=101,200)/ + & 0.74523E-01, 0.79013E-01, 0.83522E-01, 0.88048E-01, 0.92591E-01, + & 0.97150E-01, 0.10172E+00, 0.10631E+00, 0.11091E+00, 0.11552E+00, + & 0.12014E+00, 0.12478E+00, 0.12942E+00, 0.13407E+00, 0.13872E+00, + & 0.14339E+00, 0.14806E+00, 0.15273E+00, 0.15741E+00, 0.16209E+00, + & 0.16635E+00, 0.17109E+00, 0.17581E+00, 0.18054E+00, 0.18526E+00, + & 0.18997E+00, 0.19469E+00, 0.19939E+00, 0.20409E+00, 0.20879E+00, + & 0.21348E+00, 0.21816E+00, 0.22284E+00, 0.22751E+00, 0.23218E+00, + & 0.23684E+00, 0.24149E+00, 0.24614E+00, 0.25078E+00, 0.25542E+00, + & 0.26004E+00, 0.26466E+00, 0.26927E+00, 0.27388E+00, 0.27848E+00, + & 0.28307E+00, 0.28765E+00, 0.29223E+00, 0.29680E+00, 0.30136E+00, + & 0.30591E+00, 0.31045E+00, 0.31499E+00, 0.31952E+00, 0.32404E+00, + & 0.32855E+00, 0.33306E+00, 0.33755E+00, 0.34204E+00, 0.34652E+00, + & 0.35099E+00, 0.35545E+00, 0.35991E+00, 0.36436E+00, 0.36879E+00, + & 0.37322E+00, 0.37764E+00, 0.38206E+00, 0.38646E+00, 0.39086E+00, + & 0.39524E+00, 0.39962E+00, 0.40399E+00, 0.40836E+00, 0.41271E+00, + & 0.41705E+00, 0.42139E+00, 0.42572E+00, 0.43003E+00, 0.43435E+00, + & 0.43865E+00, 0.44294E+00, 0.44722E+00, 0.45150E+00, 0.45577E+00, + & 0.46003E+00, 0.46428E+00, 0.46852E+00, 0.47275E+00, 0.47698E+00, + & 0.48119E+00, 0.48540E+00, 0.48960E+00, 0.49379E+00, 0.49797E+00, + & 0.50215E+00, 0.50631E+00, 0.51047E+00, 0.51462E+00, 0.51876E+00/ + + DATA (BNC12M (I),I=201,300)/ + & 0.52289E+00, 0.52702E+00, 0.53113E+00, 0.53524E+00, 0.53934E+00, + & 0.54343E+00, 0.54751E+00, 0.55158E+00, 0.55565E+00, 0.55971E+00, + & 0.56376E+00, 0.56780E+00, 0.57183E+00, 0.57586E+00, 0.57987E+00, + & 0.58388E+00, 0.58788E+00, 0.59187E+00, 0.59586E+00, 0.59984E+00, + & 0.60381E+00, 0.60777E+00, 0.61172E+00, 0.61566E+00, 0.61960E+00, + & 0.62353E+00, 0.62745E+00, 0.63137E+00, 0.63527E+00, 0.63917E+00, + & 0.64306E+00, 0.64695E+00, 0.65082E+00, 0.65469E+00, 0.65855E+00, + & 0.66240E+00, 0.66625E+00, 0.67008E+00, 0.67391E+00, 0.67774E+00, + & 0.68155E+00, 0.68536E+00, 0.68916E+00, 0.69295E+00, 0.69674E+00, + & 0.70051E+00, 0.70428E+00, 0.70805E+00, 0.71180E+00, 0.71555E+00, + & 0.71929E+00, 0.72303E+00, 0.72676E+00, 0.73048E+00, 0.73419E+00, + & 0.73789E+00, 0.74159E+00, 0.74528E+00, 0.74897E+00, 0.75265E+00, + & 0.75632E+00, 0.75998E+00, 0.76364E+00, 0.76729E+00, 0.77093E+00, + & 0.77457E+00, 0.77819E+00, 0.78182E+00, 0.78543E+00, 0.78904E+00, + & 0.79264E+00, 0.79624E+00, 0.79983E+00, 0.80341E+00, 0.80698E+00, + & 0.81055E+00, 0.81411E+00, 0.81767E+00, 0.82122E+00, 0.82476E+00, + & 0.82830E+00, 0.83183E+00, 0.83535E+00, 0.83886E+00, 0.84237E+00, + & 0.84588E+00, 0.84938E+00, 0.85287E+00, 0.85635E+00, 0.85983E+00, + & 0.86330E+00, 0.86676E+00, 0.87022E+00, 0.87368E+00, 0.87712E+00, + & 0.88056E+00, 0.88400E+00, 0.88743E+00, 0.89085E+00, 0.89426E+00/ + + DATA (BNC12M (I),I=301,400)/ + & 0.89767E+00, 0.90108E+00, 0.90447E+00, 0.90787E+00, 0.91125E+00, + & 0.91463E+00, 0.91801E+00, 0.92137E+00, 0.92473E+00, 0.92809E+00, + & 0.93144E+00, 0.93478E+00, 0.93812E+00, 0.94145E+00, 0.94478E+00, + & 0.94810E+00, 0.95142E+00, 0.95473E+00, 0.95803E+00, 0.96133E+00, + & 0.96462E+00, 0.96791E+00, 0.97119E+00, 0.97446E+00, 0.97773E+00, + & 0.98099E+00, 0.98425E+00, 0.98750E+00, 0.99075E+00, 0.99399E+00, + & 0.99723E+00, 0.10005E+01, 0.10037E+01, 0.10069E+01, 0.10101E+01, + & 0.10133E+01, 0.10165E+01, 0.10197E+01, 0.10229E+01, 0.10261E+01, + & 0.10293E+01, 0.10325E+01, 0.10356E+01, 0.10388E+01, 0.10420E+01, + & 0.10451E+01, 0.10483E+01, 0.10514E+01, 0.10546E+01, 0.10577E+01, + & 0.10608E+01, 0.10639E+01, 0.10671E+01, 0.10702E+01, 0.10733E+01, + & 0.10764E+01, 0.10795E+01, 0.10826E+01, 0.10857E+01, 0.10888E+01, + & 0.10918E+01, 0.10949E+01, 0.10980E+01, 0.11010E+01, 0.11041E+01, + & 0.11071E+01, 0.11102E+01, 0.11132E+01, 0.11163E+01, 0.11193E+01, + & 0.11223E+01, 0.11254E+01, 0.11284E+01, 0.11314E+01, 0.11344E+01, + & 0.11374E+01, 0.11404E+01, 0.11434E+01, 0.11464E+01, 0.11494E+01, + & 0.11524E+01, 0.11553E+01, 0.11583E+01, 0.11613E+01, 0.11642E+01, + & 0.11672E+01, 0.11702E+01, 0.11731E+01, 0.11761E+01, 0.11790E+01, + & 0.11819E+01, 0.11849E+01, 0.11878E+01, 0.11907E+01, 0.11936E+01, + & 0.11965E+01, 0.11994E+01, 0.12023E+01, 0.12052E+01, 0.12081E+01/ + + DATA (BNC12M (I),I=401,500)/ + & 0.12110E+01, 0.12139E+01, 0.12168E+01, 0.12197E+01, 0.12225E+01, + & 0.12254E+01, 0.12283E+01, 0.12311E+01, 0.12340E+01, 0.12368E+01, + & 0.12397E+01, 0.12425E+01, 0.12454E+01, 0.12482E+01, 0.12510E+01, + & 0.12539E+01, 0.12567E+01, 0.12595E+01, 0.12623E+01, 0.12651E+01, + & 0.12679E+01, 0.12707E+01, 0.12735E+01, 0.12763E+01, 0.12791E+01, + & 0.12819E+01, 0.12847E+01, 0.12874E+01, 0.12902E+01, 0.12930E+01, + & 0.12957E+01, 0.12985E+01, 0.13013E+01, 0.13040E+01, 0.13068E+01, + & 0.13095E+01, 0.13122E+01, 0.13150E+01, 0.13177E+01, 0.13204E+01, + & 0.13231E+01, 0.13259E+01, 0.13286E+01, 0.13313E+01, 0.13340E+01, + & 0.13367E+01, 0.13394E+01, 0.13421E+01, 0.13448E+01, 0.13475E+01, + & 0.13502E+01, 0.13528E+01, 0.13555E+01, 0.13582E+01, 0.13609E+01, + & 0.13635E+01, 0.13662E+01, 0.13688E+01, 0.13715E+01, 0.13741E+01, + & 0.13768E+01, 0.13794E+01, 0.13821E+01, 0.13847E+01, 0.13873E+01, + & 0.13900E+01, 0.13926E+01, 0.13952E+01, 0.13978E+01, 0.14004E+01, + & 0.14031E+01, 0.14057E+01, 0.14083E+01, 0.14109E+01, 0.14135E+01, + & 0.14160E+01, 0.14186E+01, 0.14212E+01, 0.14238E+01, 0.14264E+01, + & 0.14290E+01, 0.14315E+01, 0.14341E+01, 0.14367E+01, 0.14392E+01, + & 0.14418E+01, 0.14443E+01, 0.14469E+01, 0.14494E+01, 0.14520E+01, + & 0.14545E+01, 0.14570E+01, 0.14596E+01, 0.14621E+01, 0.14646E+01, + & 0.14671E+01, 0.14697E+01, 0.14722E+01, 0.14747E+01, 0.14772E+01/ + + DATA (BNC12M (I),I=501,600)/ + & 0.14797E+01, 0.14822E+01, 0.14847E+01, 0.14872E+01, 0.14897E+01, + & 0.14922E+01, 0.14947E+01, 0.14971E+01, 0.14996E+01, 0.15021E+01, + & 0.15046E+01, 0.15070E+01, 0.15095E+01, 0.15120E+01, 0.15144E+01, + & 0.15169E+01, 0.15193E+01, 0.15218E+01, 0.15242E+01, 0.15267E+01, + & 0.15291E+01, 0.15315E+01, 0.15340E+01, 0.15364E+01, 0.15388E+01, + & 0.15413E+01, 0.15437E+01, 0.15461E+01, 0.15485E+01, 0.15509E+01, + & 0.15533E+01, 0.15557E+01, 0.15581E+01, 0.15605E+01, 0.15629E+01, + & 0.15653E+01, 0.15677E+01, 0.15701E+01, 0.15725E+01, 0.15749E+01, + & 0.15772E+01, 0.15796E+01, 0.15820E+01, 0.15843E+01, 0.15867E+01, + & 0.15891E+01, 0.15914E+01, 0.15938E+01, 0.15961E+01, 0.15985E+01, + & 0.16008E+01, 0.16032E+01, 0.16055E+01, 0.16079E+01, 0.16102E+01, + & 0.16125E+01, 0.16149E+01, 0.16172E+01, 0.16195E+01, 0.16218E+01, + & 0.16242E+01, 0.16265E+01, 0.16288E+01, 0.16311E+01, 0.16334E+01, + & 0.16357E+01, 0.16380E+01, 0.16403E+01, 0.16426E+01, 0.16449E+01, + & 0.16472E+01, 0.16495E+01, 0.16518E+01, 0.16540E+01, 0.16563E+01, + & 0.16586E+01, 0.16609E+01, 0.16631E+01, 0.16654E+01, 0.16677E+01, + & 0.16699E+01, 0.16722E+01, 0.16744E+01, 0.16767E+01, 0.16790E+01, + & 0.16812E+01, 0.16834E+01, 0.16857E+01, 0.16879E+01, 0.16902E+01, + & 0.16924E+01, 0.16946E+01, 0.16969E+01, 0.16991E+01, 0.17013E+01, + & 0.17035E+01, 0.17058E+01, 0.17080E+01, 0.17102E+01, 0.17185E+01/ + + DATA (BNC12M (I),I=601,700)/ + & 0.17365E+01, 0.17582E+01, 0.17797E+01, 0.18009E+01, 0.18218E+01, + & 0.18425E+01, 0.18630E+01, 0.18833E+01, 0.19033E+01, 0.19232E+01, + & 0.19428E+01, 0.19622E+01, 0.19814E+01, 0.20004E+01, 0.20193E+01, + & 0.20379E+01, 0.20563E+01, 0.20746E+01, 0.20927E+01, 0.21106E+01, + & 0.21283E+01, 0.21459E+01, 0.21633E+01, 0.21806E+01, 0.21976E+01, + & 0.22146E+01, 0.22313E+01, 0.22480E+01, 0.22644E+01, 0.22808E+01, + & 0.22969E+01, 0.23130E+01, 0.23289E+01, 0.23447E+01, 0.23603E+01, + & 0.23758E+01, 0.23912E+01, 0.24064E+01, 0.24215E+01, 0.24365E+01, + & 0.24514E+01, 0.24662E+01, 0.24808E+01, 0.24953E+01, 0.25097E+01, + & 0.25240E+01, 0.25382E+01, 0.25523E+01, 0.25663E+01, 0.25802E+01, + & 0.25939E+01, 0.26076E+01, 0.26211E+01, 0.26346E+01, 0.26480E+01, + & 0.26612E+01, 0.26744E+01, 0.26875E+01, 0.27005E+01, 0.27133E+01, + & 0.27262E+01, 0.27389E+01, 0.27515E+01, 0.27640E+01, 0.27765E+01, + & 0.27889E+01, 0.28012E+01, 0.28134E+01, 0.28255E+01, 0.28375E+01, + & 0.28495E+01, 0.28614E+01, 0.28732E+01, 0.28849E+01, 0.28966E+01, + & 0.29082E+01, 0.29197E+01, 0.29312E+01, 0.29425E+01, 0.29538E+01, + & 0.29651E+01, 0.29762E+01, 0.29873E+01, 0.29984E+01, 0.30093E+01, + & 0.30202E+01, 0.30311E+01, 0.30419E+01, 0.30526E+01, 0.30632E+01, + & 0.30738E+01, 0.30843E+01, 0.30948E+01, 0.31052E+01, 0.31155E+01, + & 0.31258E+01, 0.31361E+01, 0.31462E+01, 0.31564E+01, 0.31664E+01/ + + DATA (BNC12M(I),I=701,741)/ + & 0.31764E+01, 0.31864E+01, 0.31963E+01, 0.32061E+01, 0.32159E+01, + & 0.32257E+01, 0.32354E+01, 0.32450E+01, 0.32546E+01, 0.32641E+01, + & 0.32736E+01, 0.32831E+01, 0.32924E+01, 0.33018E+01, 0.33111E+01, + & 0.33203E+01, 0.33295E+01, 0.33387E+01, 0.33478E+01, 0.33569E+01, + & 0.33659E+01, 0.33749E+01, 0.33838E+01, 0.33927E+01, 0.34016E+01, + & 0.34104E+01, 0.34191E+01, 0.34278E+01, 0.34365E+01, 0.34452E+01, + & 0.34538E+01, 0.34623E+01, 0.34708E+01, 0.34793E+01, 0.34878E+01, + & 0.34962E+01, 0.35045E+01, 0.35128E+01, 0.35211E+01, 0.35294E+01, + & 0.35376E+01 + & / +C +C *** (NH4)3H(SO4)2 +C + DATA (BNC13M (I),I= 1,100)/ + &-0.82022E-01,-0.14892E+00,-0.19572E+00,-0.22741E+00,-0.25173E+00, + &-0.27155E+00,-0.28831E+00,-0.30283E+00,-0.31565E+00,-0.32710E+00, + &-0.33746E+00,-0.34689E+00,-0.35555E+00,-0.36355E+00,-0.37096E+00, + &-0.37786E+00,-0.38431E+00,-0.39036E+00,-0.39605E+00,-0.40141E+00, + &-0.40647E+00,-0.41126E+00,-0.41580E+00,-0.42010E+00,-0.42419E+00, + &-0.42808E+00,-0.43179E+00,-0.43532E+00,-0.43868E+00,-0.44190E+00, + &-0.44496E+00,-0.44790E+00,-0.45070E+00,-0.45338E+00,-0.45594E+00, + &-0.45839E+00,-0.46074E+00,-0.46298E+00,-0.46513E+00,-0.46719E+00, + &-0.46916E+00,-0.47105E+00,-0.47285E+00,-0.47458E+00,-0.47624E+00, + &-0.47782E+00,-0.47934E+00,-0.48079E+00,-0.48217E+00,-0.48350E+00, + &-0.48477E+00,-0.48598E+00,-0.48713E+00,-0.48824E+00,-0.48929E+00, + &-0.49030E+00,-0.49125E+00,-0.49217E+00,-0.49304E+00,-0.49386E+00, + &-0.49465E+00,-0.49539E+00,-0.49610E+00,-0.49677E+00,-0.49740E+00, + &-0.49800E+00,-0.49856E+00,-0.49910E+00,-0.49960E+00,-0.50006E+00, + &-0.50050E+00,-0.50091E+00,-0.50129E+00,-0.50164E+00,-0.50197E+00, + &-0.50227E+00,-0.50254E+00,-0.50279E+00,-0.50301E+00,-0.50321E+00, + &-0.50338E+00,-0.50353E+00,-0.50366E+00,-0.50377E+00,-0.50386E+00, + &-0.50392E+00,-0.50396E+00,-0.50399E+00,-0.50399E+00,-0.50398E+00, + &-0.50394E+00,-0.50389E+00,-0.50382E+00,-0.50373E+00,-0.50362E+00, + &-0.50350E+00,-0.50336E+00,-0.50320E+00,-0.50303E+00,-0.50285E+00/ + + DATA (BNC13M (I),I=101,200)/ + &-0.50265E+00,-0.50243E+00,-0.50220E+00,-0.50196E+00,-0.50171E+00, + &-0.50144E+00,-0.50116E+00,-0.50087E+00,-0.50056E+00,-0.50025E+00, + &-0.49993E+00,-0.49959E+00,-0.49925E+00,-0.49890E+00,-0.49853E+00, + &-0.49816E+00,-0.49778E+00,-0.49739E+00,-0.49700E+00,-0.49660E+00, + &-0.49627E+00,-0.49584E+00,-0.49541E+00,-0.49497E+00,-0.49453E+00, + &-0.49408E+00,-0.49363E+00,-0.49317E+00,-0.49271E+00,-0.49225E+00, + &-0.49178E+00,-0.49130E+00,-0.49082E+00,-0.49034E+00,-0.48986E+00, + &-0.48937E+00,-0.48887E+00,-0.48838E+00,-0.48788E+00,-0.48738E+00, + &-0.48687E+00,-0.48636E+00,-0.48585E+00,-0.48534E+00,-0.48482E+00, + &-0.48430E+00,-0.48378E+00,-0.48326E+00,-0.48273E+00,-0.48221E+00, + &-0.48168E+00,-0.48115E+00,-0.48061E+00,-0.48008E+00,-0.47954E+00, + &-0.47900E+00,-0.47846E+00,-0.47792E+00,-0.47738E+00,-0.47683E+00, + &-0.47628E+00,-0.47574E+00,-0.47519E+00,-0.47464E+00,-0.47409E+00, + &-0.47354E+00,-0.47298E+00,-0.47243E+00,-0.47187E+00,-0.47132E+00, + &-0.47076E+00,-0.47020E+00,-0.46964E+00,-0.46908E+00,-0.46852E+00, + &-0.46796E+00,-0.46740E+00,-0.46684E+00,-0.46628E+00,-0.46572E+00, + &-0.46515E+00,-0.46459E+00,-0.46402E+00,-0.46346E+00,-0.46289E+00, + &-0.46233E+00,-0.46176E+00,-0.46120E+00,-0.46063E+00,-0.46006E+00, + &-0.45950E+00,-0.45893E+00,-0.45836E+00,-0.45780E+00,-0.45723E+00, + &-0.45666E+00,-0.45609E+00,-0.45553E+00,-0.45496E+00,-0.45439E+00/ + + DATA (BNC13M (I),I=201,300)/ + &-0.45382E+00,-0.45325E+00,-0.45269E+00,-0.45212E+00,-0.45155E+00, + &-0.45098E+00,-0.45041E+00,-0.44985E+00,-0.44928E+00,-0.44871E+00, + &-0.44814E+00,-0.44758E+00,-0.44701E+00,-0.44644E+00,-0.44588E+00, + &-0.44531E+00,-0.44474E+00,-0.44418E+00,-0.44361E+00,-0.44305E+00, + &-0.44248E+00,-0.44192E+00,-0.44135E+00,-0.44079E+00,-0.44022E+00, + &-0.43966E+00,-0.43909E+00,-0.43853E+00,-0.43797E+00,-0.43740E+00, + &-0.43684E+00,-0.43628E+00,-0.43572E+00,-0.43515E+00,-0.43459E+00, + &-0.43403E+00,-0.43347E+00,-0.43291E+00,-0.43235E+00,-0.43179E+00, + &-0.43123E+00,-0.43067E+00,-0.43012E+00,-0.42956E+00,-0.42900E+00, + &-0.42844E+00,-0.42789E+00,-0.42733E+00,-0.42678E+00,-0.42622E+00, + &-0.42567E+00,-0.42511E+00,-0.42456E+00,-0.42400E+00,-0.42345E+00, + &-0.42290E+00,-0.42234E+00,-0.42179E+00,-0.42124E+00,-0.42069E+00, + &-0.42014E+00,-0.41959E+00,-0.41904E+00,-0.41849E+00,-0.41794E+00, + &-0.41740E+00,-0.41685E+00,-0.41630E+00,-0.41575E+00,-0.41521E+00, + &-0.41466E+00,-0.41412E+00,-0.41357E+00,-0.41303E+00,-0.41249E+00, + &-0.41194E+00,-0.41140E+00,-0.41086E+00,-0.41032E+00,-0.40977E+00, + &-0.40923E+00,-0.40869E+00,-0.40815E+00,-0.40762E+00,-0.40708E+00, + &-0.40654E+00,-0.40600E+00,-0.40547E+00,-0.40493E+00,-0.40439E+00, + &-0.40386E+00,-0.40332E+00,-0.40279E+00,-0.40225E+00,-0.40172E+00, + &-0.40119E+00,-0.40066E+00,-0.40013E+00,-0.39959E+00,-0.39906E+00/ + + DATA (BNC13M (I),I=301,400)/ + &-0.39853E+00,-0.39800E+00,-0.39747E+00,-0.39695E+00,-0.39642E+00, + &-0.39589E+00,-0.39536E+00,-0.39484E+00,-0.39431E+00,-0.39379E+00, + &-0.39326E+00,-0.39274E+00,-0.39221E+00,-0.39169E+00,-0.39117E+00, + &-0.39065E+00,-0.39013E+00,-0.38961E+00,-0.38908E+00,-0.38857E+00, + &-0.38805E+00,-0.38753E+00,-0.38701E+00,-0.38649E+00,-0.38597E+00, + &-0.38546E+00,-0.38494E+00,-0.38443E+00,-0.38391E+00,-0.38340E+00, + &-0.38288E+00,-0.38237E+00,-0.38186E+00,-0.38135E+00,-0.38083E+00, + &-0.38032E+00,-0.37981E+00,-0.37930E+00,-0.37879E+00,-0.37828E+00, + &-0.37778E+00,-0.37727E+00,-0.37676E+00,-0.37625E+00,-0.37575E+00, + &-0.37524E+00,-0.37474E+00,-0.37423E+00,-0.37373E+00,-0.37322E+00, + &-0.37272E+00,-0.37222E+00,-0.37172E+00,-0.37122E+00,-0.37071E+00, + &-0.37021E+00,-0.36971E+00,-0.36922E+00,-0.36872E+00,-0.36822E+00, + &-0.36772E+00,-0.36722E+00,-0.36673E+00,-0.36623E+00,-0.36574E+00, + &-0.36524E+00,-0.36475E+00,-0.36425E+00,-0.36376E+00,-0.36327E+00, + &-0.36277E+00,-0.36228E+00,-0.36179E+00,-0.36130E+00,-0.36081E+00, + &-0.36032E+00,-0.35983E+00,-0.35934E+00,-0.35886E+00,-0.35837E+00, + &-0.35788E+00,-0.35739E+00,-0.35691E+00,-0.35642E+00,-0.35594E+00, + &-0.35545E+00,-0.35497E+00,-0.35449E+00,-0.35400E+00,-0.35352E+00, + &-0.35304E+00,-0.35256E+00,-0.35208E+00,-0.35160E+00,-0.35112E+00, + &-0.35064E+00,-0.35016E+00,-0.34968E+00,-0.34920E+00,-0.34873E+00/ + + DATA (BNC13M (I),I=401,500)/ + &-0.34825E+00,-0.34777E+00,-0.34730E+00,-0.34682E+00,-0.34635E+00, + &-0.34588E+00,-0.34540E+00,-0.34493E+00,-0.34446E+00,-0.34398E+00, + &-0.34351E+00,-0.34304E+00,-0.34257E+00,-0.34210E+00,-0.34163E+00, + &-0.34116E+00,-0.34069E+00,-0.34023E+00,-0.33976E+00,-0.33929E+00, + &-0.33882E+00,-0.33836E+00,-0.33789E+00,-0.33743E+00,-0.33696E+00, + &-0.33650E+00,-0.33604E+00,-0.33557E+00,-0.33511E+00,-0.33465E+00, + &-0.33419E+00,-0.33373E+00,-0.33327E+00,-0.33281E+00,-0.33235E+00, + &-0.33189E+00,-0.33143E+00,-0.33097E+00,-0.33051E+00,-0.33006E+00, + &-0.32960E+00,-0.32914E+00,-0.32869E+00,-0.32823E+00,-0.32778E+00, + &-0.32732E+00,-0.32687E+00,-0.32642E+00,-0.32596E+00,-0.32551E+00, + &-0.32506E+00,-0.32461E+00,-0.32416E+00,-0.32371E+00,-0.32326E+00, + &-0.32281E+00,-0.32236E+00,-0.32191E+00,-0.32146E+00,-0.32101E+00, + &-0.32057E+00,-0.32012E+00,-0.31967E+00,-0.31923E+00,-0.31878E+00, + &-0.31834E+00,-0.31789E+00,-0.31745E+00,-0.31701E+00,-0.31656E+00, + &-0.31612E+00,-0.31568E+00,-0.31524E+00,-0.31480E+00,-0.31436E+00, + &-0.31392E+00,-0.31348E+00,-0.31304E+00,-0.31260E+00,-0.31216E+00, + &-0.31172E+00,-0.31128E+00,-0.31085E+00,-0.31041E+00,-0.30997E+00, + &-0.30954E+00,-0.30910E+00,-0.30867E+00,-0.30823E+00,-0.30780E+00, + &-0.30737E+00,-0.30693E+00,-0.30650E+00,-0.30607E+00,-0.30564E+00, + &-0.30521E+00,-0.30478E+00,-0.30435E+00,-0.30392E+00,-0.30349E+00/ + + DATA (BNC13M (I),I=501,600)/ + &-0.30306E+00,-0.30263E+00,-0.30220E+00,-0.30177E+00,-0.30135E+00, + &-0.30092E+00,-0.30049E+00,-0.30007E+00,-0.29964E+00,-0.29922E+00, + &-0.29879E+00,-0.29837E+00,-0.29794E+00,-0.29752E+00,-0.29710E+00, + &-0.29668E+00,-0.29625E+00,-0.29583E+00,-0.29541E+00,-0.29499E+00, + &-0.29457E+00,-0.29415E+00,-0.29373E+00,-0.29331E+00,-0.29289E+00, + &-0.29248E+00,-0.29206E+00,-0.29164E+00,-0.29122E+00,-0.29081E+00, + &-0.29039E+00,-0.28997E+00,-0.28956E+00,-0.28914E+00,-0.28873E+00, + &-0.28832E+00,-0.28790E+00,-0.28749E+00,-0.28708E+00,-0.28666E+00, + &-0.28625E+00,-0.28584E+00,-0.28543E+00,-0.28502E+00,-0.28461E+00, + &-0.28420E+00,-0.28379E+00,-0.28338E+00,-0.28297E+00,-0.28256E+00, + &-0.28216E+00,-0.28175E+00,-0.28134E+00,-0.28093E+00,-0.28053E+00, + &-0.28012E+00,-0.27972E+00,-0.27931E+00,-0.27891E+00,-0.27850E+00, + &-0.27810E+00,-0.27770E+00,-0.27729E+00,-0.27689E+00,-0.27649E+00, + &-0.27609E+00,-0.27568E+00,-0.27528E+00,-0.27488E+00,-0.27448E+00, + &-0.27408E+00,-0.27368E+00,-0.27328E+00,-0.27288E+00,-0.27249E+00, + &-0.27209E+00,-0.27169E+00,-0.27129E+00,-0.27090E+00,-0.27050E+00, + &-0.27010E+00,-0.26971E+00,-0.26931E+00,-0.26892E+00,-0.26852E+00, + &-0.26813E+00,-0.26774E+00,-0.26734E+00,-0.26695E+00,-0.26656E+00, + &-0.26616E+00,-0.26577E+00,-0.26538E+00,-0.26499E+00,-0.26460E+00, + &-0.26421E+00,-0.26382E+00,-0.26343E+00,-0.26304E+00,-0.26158E+00/ + + DATA (BNC13M (I),I=601,700)/ + &-0.25840E+00,-0.25457E+00,-0.25078E+00,-0.24702E+00,-0.24330E+00, + &-0.23961E+00,-0.23595E+00,-0.23233E+00,-0.22874E+00,-0.22518E+00, + &-0.22165E+00,-0.21815E+00,-0.21469E+00,-0.21125E+00,-0.20784E+00, + &-0.20447E+00,-0.20112E+00,-0.19779E+00,-0.19450E+00,-0.19123E+00, + &-0.18799E+00,-0.18477E+00,-0.18158E+00,-0.17842E+00,-0.17528E+00, + &-0.17217E+00,-0.16907E+00,-0.16601E+00,-0.16297E+00,-0.15995E+00, + &-0.15695E+00,-0.15397E+00,-0.15102E+00,-0.14809E+00,-0.14518E+00, + &-0.14229E+00,-0.13943E+00,-0.13658E+00,-0.13375E+00,-0.13095E+00, + &-0.12816E+00,-0.12539E+00,-0.12265E+00,-0.11992E+00,-0.11721E+00, + &-0.11452E+00,-0.11184E+00,-0.10919E+00,-0.10655E+00,-0.10393E+00, + &-0.10133E+00,-0.98739E-01,-0.96170E-01,-0.93617E-01,-0.91081E-01, + &-0.88561E-01,-0.86056E-01,-0.83568E-01,-0.81095E-01,-0.78637E-01, + &-0.76195E-01,-0.73767E-01,-0.71355E-01,-0.68957E-01,-0.66573E-01, + &-0.64204E-01,-0.61849E-01,-0.59507E-01,-0.57180E-01,-0.54866E-01, + &-0.52566E-01,-0.50279E-01,-0.48005E-01,-0.45744E-01,-0.43496E-01, + &-0.41260E-01,-0.39037E-01,-0.36827E-01,-0.34628E-01,-0.32442E-01, + &-0.30268E-01,-0.28106E-01,-0.25956E-01,-0.23817E-01,-0.21689E-01, + &-0.19574E-01,-0.17469E-01,-0.15375E-01,-0.13292E-01,-0.11221E-01, + &-0.91598E-02,-0.71093E-02,-0.50696E-02,-0.30402E-02,-0.10212E-02, + & 0.98748E-03, 0.29862E-02, 0.49749E-02, 0.69534E-02, 0.89223E-02/ + + DATA (BNC13M(I),I=701,741)/ + & 0.10881E-01, 0.12831E-01, 0.14771E-01, 0.16702E-01, 0.18623E-01, + & 0.20535E-01, 0.22438E-01, 0.24331E-01, 0.26216E-01, 0.28092E-01, + & 0.29959E-01, 0.31817E-01, 0.33667E-01, 0.35508E-01, 0.37340E-01, + & 0.39165E-01, 0.40981E-01, 0.42788E-01, 0.44588E-01, 0.46379E-01, + & 0.48162E-01, 0.49937E-01, 0.51705E-01, 0.53464E-01, 0.55216E-01, + & 0.56961E-01, 0.58697E-01, 0.60426E-01, 0.62148E-01, 0.63862E-01, + & 0.65569E-01, 0.67268E-01, 0.68960E-01, 0.70645E-01, 0.72323E-01, + & 0.73994E-01, 0.75658E-01, 0.77315E-01, 0.78966E-01, 0.80609E-01, + & 0.82246E-01 + & / + END + +C *** TEMP = 323.0 + + BLOCK DATA KMCF323 +C +C *** Common block definition +C + COMMON /KMC323/ + &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741), + &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741), + &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741), + &BNC13M( 741) +C +C *** NaCl +C + DATA (BNC01M (I),I= 1,100)/ + &-0.48816E-01,-0.86364E-01,-0.11089E+00,-0.12640E+00,-0.13753E+00, + &-0.14603E+00,-0.15274E+00,-0.15816E+00,-0.16259E+00,-0.16624E+00, + &-0.16927E+00,-0.17179E+00,-0.17387E+00,-0.17559E+00,-0.17699E+00, + &-0.17812E+00,-0.17901E+00,-0.17968E+00,-0.18017E+00,-0.18049E+00, + &-0.18066E+00,-0.18070E+00,-0.18061E+00,-0.18042E+00,-0.18013E+00, + &-0.17974E+00,-0.17927E+00,-0.17873E+00,-0.17812E+00,-0.17744E+00, + &-0.17671E+00,-0.17593E+00,-0.17509E+00,-0.17421E+00,-0.17329E+00, + &-0.17233E+00,-0.17134E+00,-0.17031E+00,-0.16926E+00,-0.16817E+00, + &-0.16707E+00,-0.16594E+00,-0.16479E+00,-0.16362E+00,-0.16243E+00, + &-0.16122E+00,-0.16000E+00,-0.15877E+00,-0.15752E+00,-0.15626E+00, + &-0.15499E+00,-0.15371E+00,-0.15242E+00,-0.15112E+00,-0.14981E+00, + &-0.14849E+00,-0.14716E+00,-0.14583E+00,-0.14448E+00,-0.14313E+00, + &-0.14177E+00,-0.14041E+00,-0.13904E+00,-0.13766E+00,-0.13627E+00, + &-0.13487E+00,-0.13347E+00,-0.13206E+00,-0.13063E+00,-0.12920E+00, + &-0.12777E+00,-0.12632E+00,-0.12486E+00,-0.12340E+00,-0.12192E+00, + &-0.12043E+00,-0.11893E+00,-0.11743E+00,-0.11591E+00,-0.11438E+00, + &-0.11283E+00,-0.11128E+00,-0.10972E+00,-0.10814E+00,-0.10655E+00, + &-0.10495E+00,-0.10333E+00,-0.10171E+00,-0.10007E+00,-0.98421E-01, + &-0.96759E-01,-0.95085E-01,-0.93399E-01,-0.91702E-01,-0.89993E-01, + &-0.88272E-01,-0.86541E-01,-0.84798E-01,-0.83045E-01,-0.81282E-01/ + + DATA (BNC01M (I),I=101,200)/ + &-0.79509E-01,-0.77726E-01,-0.75934E-01,-0.74133E-01,-0.72323E-01, + &-0.70506E-01,-0.68680E-01,-0.66847E-01,-0.65007E-01,-0.63160E-01, + &-0.61307E-01,-0.59447E-01,-0.57583E-01,-0.55713E-01,-0.53838E-01, + &-0.51958E-01,-0.50075E-01,-0.48187E-01,-0.46296E-01,-0.44402E-01, + &-0.42697E-01,-0.40775E-01,-0.38852E-01,-0.36930E-01,-0.35007E-01, + &-0.33085E-01,-0.31163E-01,-0.29240E-01,-0.27318E-01,-0.25397E-01, + &-0.23475E-01,-0.21554E-01,-0.19634E-01,-0.17714E-01,-0.15794E-01, + &-0.13875E-01,-0.11957E-01,-0.10039E-01,-0.81222E-02,-0.62060E-02, + &-0.42906E-02,-0.23761E-02,-0.46246E-03, 0.14502E-02, 0.33620E-02, + & 0.52727E-02, 0.71824E-02, 0.90910E-02, 0.10999E-01, 0.12905E-01, + & 0.14810E-01, 0.16714E-01, 0.18617E-01, 0.20518E-01, 0.22419E-01, + & 0.24317E-01, 0.26215E-01, 0.28111E-01, 0.30006E-01, 0.31899E-01, + & 0.33791E-01, 0.35682E-01, 0.37571E-01, 0.39458E-01, 0.41344E-01, + & 0.43228E-01, 0.45111E-01, 0.46992E-01, 0.48871E-01, 0.50749E-01, + & 0.52625E-01, 0.54500E-01, 0.56373E-01, 0.58244E-01, 0.60113E-01, + & 0.61981E-01, 0.63847E-01, 0.65711E-01, 0.67573E-01, 0.69434E-01, + & 0.71292E-01, 0.73149E-01, 0.75004E-01, 0.76857E-01, 0.78709E-01, + & 0.80558E-01, 0.82406E-01, 0.84251E-01, 0.86095E-01, 0.87937E-01, + & 0.89776E-01, 0.91614E-01, 0.93450E-01, 0.95284E-01, 0.97116E-01, + & 0.98946E-01, 0.10077E+00, 0.10260E+00, 0.10442E+00, 0.10625E+00/ + + DATA (BNC01M (I),I=201,300)/ + & 0.10807E+00, 0.10988E+00, 0.11170E+00, 0.11351E+00, 0.11533E+00, + & 0.11714E+00, 0.11894E+00, 0.12075E+00, 0.12255E+00, 0.12435E+00, + & 0.12615E+00, 0.12795E+00, 0.12975E+00, 0.13154E+00, 0.13333E+00, + & 0.13512E+00, 0.13691E+00, 0.13869E+00, 0.14047E+00, 0.14226E+00, + & 0.14403E+00, 0.14581E+00, 0.14758E+00, 0.14936E+00, 0.15113E+00, + & 0.15289E+00, 0.15466E+00, 0.15642E+00, 0.15818E+00, 0.15994E+00, + & 0.16170E+00, 0.16346E+00, 0.16521E+00, 0.16696E+00, 0.16871E+00, + & 0.17045E+00, 0.17220E+00, 0.17394E+00, 0.17568E+00, 0.17742E+00, + & 0.17915E+00, 0.18089E+00, 0.18262E+00, 0.18435E+00, 0.18608E+00, + & 0.18780E+00, 0.18952E+00, 0.19124E+00, 0.19296E+00, 0.19468E+00, + & 0.19639E+00, 0.19811E+00, 0.19982E+00, 0.20152E+00, 0.20323E+00, + & 0.20493E+00, 0.20663E+00, 0.20833E+00, 0.21003E+00, 0.21172E+00, + & 0.21342E+00, 0.21511E+00, 0.21680E+00, 0.21848E+00, 0.22017E+00, + & 0.22185E+00, 0.22353E+00, 0.22521E+00, 0.22688E+00, 0.22856E+00, + & 0.23023E+00, 0.23190E+00, 0.23356E+00, 0.23523E+00, 0.23689E+00, + & 0.23855E+00, 0.24021E+00, 0.24187E+00, 0.24352E+00, 0.24518E+00, + & 0.24683E+00, 0.24847E+00, 0.25012E+00, 0.25176E+00, 0.25341E+00, + & 0.25505E+00, 0.25668E+00, 0.25832E+00, 0.25995E+00, 0.26158E+00, + & 0.26321E+00, 0.26484E+00, 0.26647E+00, 0.26809E+00, 0.26971E+00, + & 0.27133E+00, 0.27295E+00, 0.27456E+00, 0.27618E+00, 0.27779E+00/ + + DATA (BNC01M (I),I=301,400)/ + & 0.27940E+00, 0.28100E+00, 0.28261E+00, 0.28421E+00, 0.28581E+00, + & 0.28741E+00, 0.28901E+00, 0.29060E+00, 0.29219E+00, 0.29378E+00, + & 0.29537E+00, 0.29696E+00, 0.29854E+00, 0.30012E+00, 0.30171E+00, + & 0.30328E+00, 0.30486E+00, 0.30643E+00, 0.30801E+00, 0.30958E+00, + & 0.31115E+00, 0.31271E+00, 0.31428E+00, 0.31584E+00, 0.31740E+00, + & 0.31896E+00, 0.32052E+00, 0.32207E+00, 0.32362E+00, 0.32517E+00, + & 0.32672E+00, 0.32827E+00, 0.32982E+00, 0.33136E+00, 0.33290E+00, + & 0.33444E+00, 0.33598E+00, 0.33751E+00, 0.33904E+00, 0.34058E+00, + & 0.34211E+00, 0.34363E+00, 0.34516E+00, 0.34668E+00, 0.34820E+00, + & 0.34972E+00, 0.35124E+00, 0.35276E+00, 0.35427E+00, 0.35579E+00, + & 0.35730E+00, 0.35881E+00, 0.36031E+00, 0.36182E+00, 0.36332E+00, + & 0.36482E+00, 0.36632E+00, 0.36782E+00, 0.36931E+00, 0.37081E+00, + & 0.37230E+00, 0.37379E+00, 0.37528E+00, 0.37677E+00, 0.37825E+00, + & 0.37973E+00, 0.38121E+00, 0.38269E+00, 0.38417E+00, 0.38565E+00, + & 0.38712E+00, 0.38859E+00, 0.39006E+00, 0.39153E+00, 0.39300E+00, + & 0.39446E+00, 0.39593E+00, 0.39739E+00, 0.39885E+00, 0.40030E+00, + & 0.40176E+00, 0.40321E+00, 0.40467E+00, 0.40612E+00, 0.40757E+00, + & 0.40901E+00, 0.41046E+00, 0.41190E+00, 0.41334E+00, 0.41478E+00, + & 0.41622E+00, 0.41766E+00, 0.41909E+00, 0.42053E+00, 0.42196E+00, + & 0.42339E+00, 0.42482E+00, 0.42624E+00, 0.42767E+00, 0.42909E+00/ + + DATA (BNC01M (I),I=401,500)/ + & 0.43051E+00, 0.43193E+00, 0.43335E+00, 0.43477E+00, 0.43618E+00, + & 0.43759E+00, 0.43901E+00, 0.44042E+00, 0.44182E+00, 0.44323E+00, + & 0.44463E+00, 0.44604E+00, 0.44744E+00, 0.44884E+00, 0.45024E+00, + & 0.45163E+00, 0.45303E+00, 0.45442E+00, 0.45581E+00, 0.45720E+00, + & 0.45859E+00, 0.45998E+00, 0.46136E+00, 0.46274E+00, 0.46413E+00, + & 0.46551E+00, 0.46689E+00, 0.46826E+00, 0.46964E+00, 0.47101E+00, + & 0.47238E+00, 0.47375E+00, 0.47512E+00, 0.47649E+00, 0.47786E+00, + & 0.47922E+00, 0.48058E+00, 0.48194E+00, 0.48330E+00, 0.48466E+00, + & 0.48602E+00, 0.48737E+00, 0.48873E+00, 0.49008E+00, 0.49143E+00, + & 0.49278E+00, 0.49412E+00, 0.49547E+00, 0.49681E+00, 0.49816E+00, + & 0.49950E+00, 0.50084E+00, 0.50217E+00, 0.50351E+00, 0.50485E+00, + & 0.50618E+00, 0.50751E+00, 0.50884E+00, 0.51017E+00, 0.51150E+00, + & 0.51282E+00, 0.51415E+00, 0.51547E+00, 0.51679E+00, 0.51811E+00, + & 0.51943E+00, 0.52075E+00, 0.52206E+00, 0.52338E+00, 0.52469E+00, + & 0.52600E+00, 0.52731E+00, 0.52862E+00, 0.52993E+00, 0.53123E+00, + & 0.53254E+00, 0.53384E+00, 0.53514E+00, 0.53644E+00, 0.53774E+00, + & 0.53904E+00, 0.54033E+00, 0.54162E+00, 0.54292E+00, 0.54421E+00, + & 0.54550E+00, 0.54679E+00, 0.54807E+00, 0.54936E+00, 0.55064E+00, + & 0.55193E+00, 0.55321E+00, 0.55449E+00, 0.55577E+00, 0.55704E+00, + & 0.55832E+00, 0.55959E+00, 0.56087E+00, 0.56214E+00, 0.56341E+00/ + + DATA (BNC01M (I),I=501,600)/ + & 0.56468E+00, 0.56594E+00, 0.56721E+00, 0.56848E+00, 0.56974E+00, + & 0.57100E+00, 0.57226E+00, 0.57352E+00, 0.57478E+00, 0.57604E+00, + & 0.57729E+00, 0.57855E+00, 0.57980E+00, 0.58105E+00, 0.58230E+00, + & 0.58355E+00, 0.58480E+00, 0.58604E+00, 0.58729E+00, 0.58853E+00, + & 0.58977E+00, 0.59101E+00, 0.59225E+00, 0.59349E+00, 0.59473E+00, + & 0.59596E+00, 0.59720E+00, 0.59843E+00, 0.59966E+00, 0.60089E+00, + & 0.60212E+00, 0.60335E+00, 0.60458E+00, 0.60580E+00, 0.60703E+00, + & 0.60825E+00, 0.60947E+00, 0.61069E+00, 0.61191E+00, 0.61313E+00, + & 0.61435E+00, 0.61556E+00, 0.61678E+00, 0.61799E+00, 0.61920E+00, + & 0.62041E+00, 0.62162E+00, 0.62283E+00, 0.62403E+00, 0.62524E+00, + & 0.62644E+00, 0.62765E+00, 0.62885E+00, 0.63005E+00, 0.63125E+00, + & 0.63245E+00, 0.63364E+00, 0.63484E+00, 0.63603E+00, 0.63723E+00, + & 0.63842E+00, 0.63961E+00, 0.64080E+00, 0.64199E+00, 0.64318E+00, + & 0.64436E+00, 0.64555E+00, 0.64673E+00, 0.64791E+00, 0.64909E+00, + & 0.65027E+00, 0.65145E+00, 0.65263E+00, 0.65381E+00, 0.65498E+00, + & 0.65616E+00, 0.65733E+00, 0.65850E+00, 0.65967E+00, 0.66084E+00, + & 0.66201E+00, 0.66318E+00, 0.66435E+00, 0.66551E+00, 0.66667E+00, + & 0.66784E+00, 0.66900E+00, 0.67016E+00, 0.67132E+00, 0.67248E+00, + & 0.67363E+00, 0.67479E+00, 0.67595E+00, 0.67710E+00, 0.67825E+00, + & 0.67940E+00, 0.68055E+00, 0.68170E+00, 0.68285E+00, 0.68715E+00/ + + DATA (BNC01M (I),I=601,700)/ + & 0.69654E+00, 0.70783E+00, 0.71902E+00, 0.73010E+00, 0.74108E+00, + & 0.75196E+00, 0.76274E+00, 0.77342E+00, 0.78402E+00, 0.79451E+00, + & 0.80492E+00, 0.81524E+00, 0.82547E+00, 0.83562E+00, 0.84568E+00, + & 0.85566E+00, 0.86556E+00, 0.87538E+00, 0.88512E+00, 0.89478E+00, + & 0.90437E+00, 0.91389E+00, 0.92333E+00, 0.93270E+00, 0.94200E+00, + & 0.95123E+00, 0.96040E+00, 0.96949E+00, 0.97852E+00, 0.98749E+00, + & 0.99639E+00, 0.10052E+01, 0.10140E+01, 0.10227E+01, 0.10314E+01, + & 0.10400E+01, 0.10485E+01, 0.10570E+01, 0.10654E+01, 0.10738E+01, + & 0.10821E+01, 0.10904E+01, 0.10986E+01, 0.11068E+01, 0.11149E+01, + & 0.11230E+01, 0.11310E+01, 0.11389E+01, 0.11469E+01, 0.11547E+01, + & 0.11625E+01, 0.11703E+01, 0.11780E+01, 0.11857E+01, 0.11934E+01, + & 0.12010E+01, 0.12085E+01, 0.12160E+01, 0.12235E+01, 0.12309E+01, + & 0.12383E+01, 0.12457E+01, 0.12530E+01, 0.12602E+01, 0.12675E+01, + & 0.12747E+01, 0.12818E+01, 0.12889E+01, 0.12960E+01, 0.13031E+01, + & 0.13101E+01, 0.13170E+01, 0.13240E+01, 0.13309E+01, 0.13378E+01, + & 0.13446E+01, 0.13514E+01, 0.13582E+01, 0.13649E+01, 0.13716E+01, + & 0.13783E+01, 0.13849E+01, 0.13915E+01, 0.13981E+01, 0.14047E+01, + & 0.14112E+01, 0.14177E+01, 0.14241E+01, 0.14306E+01, 0.14370E+01, + & 0.14434E+01, 0.14497E+01, 0.14560E+01, 0.14623E+01, 0.14686E+01, + & 0.14748E+01, 0.14810E+01, 0.14872E+01, 0.14934E+01, 0.14995E+01/ + + DATA (BNC01M(I),I=701,741)/ + & 0.15056E+01, 0.15117E+01, 0.15178E+01, 0.15238E+01, 0.15298E+01, + & 0.15358E+01, 0.15418E+01, 0.15477E+01, 0.15536E+01, 0.15595E+01, + & 0.15654E+01, 0.15713E+01, 0.15771E+01, 0.15829E+01, 0.15887E+01, + & 0.15944E+01, 0.16002E+01, 0.16059E+01, 0.16116E+01, 0.16173E+01, + & 0.16229E+01, 0.16286E+01, 0.16342E+01, 0.16398E+01, 0.16453E+01, + & 0.16509E+01, 0.16564E+01, 0.16620E+01, 0.16675E+01, 0.16729E+01, + & 0.16784E+01, 0.16838E+01, 0.16893E+01, 0.16947E+01, 0.17000E+01, + & 0.17054E+01, 0.17108E+01, 0.17161E+01, 0.17214E+01, 0.17267E+01, + & 0.17320E+01 + & / +C +C *** Na2SO4 +C + DATA (BNC02M (I),I= 1,100)/ + &-0.10024E+00,-0.18230E+00,-0.23981E+00,-0.27879E+00,-0.30871E+00, + &-0.33311E+00,-0.35376E+00,-0.37167E+00,-0.38749E+00,-0.40165E+00, + &-0.41447E+00,-0.42617E+00,-0.43693E+00,-0.44690E+00,-0.45616E+00, + &-0.46482E+00,-0.47294E+00,-0.48058E+00,-0.48780E+00,-0.49464E+00, + &-0.50113E+00,-0.50730E+00,-0.51318E+00,-0.51880E+00,-0.52418E+00, + &-0.52933E+00,-0.53428E+00,-0.53903E+00,-0.54360E+00,-0.54800E+00, + &-0.55224E+00,-0.55634E+00,-0.56030E+00,-0.56412E+00,-0.56783E+00, + &-0.57141E+00,-0.57489E+00,-0.57826E+00,-0.58153E+00,-0.58471E+00, + &-0.58779E+00,-0.59080E+00,-0.59371E+00,-0.59655E+00,-0.59932E+00, + &-0.60201E+00,-0.60464E+00,-0.60720E+00,-0.60969E+00,-0.61213E+00, + &-0.61451E+00,-0.61683E+00,-0.61910E+00,-0.62131E+00,-0.62348E+00, + &-0.62560E+00,-0.62767E+00,-0.62970E+00,-0.63168E+00,-0.63362E+00, + &-0.63553E+00,-0.63739E+00,-0.63922E+00,-0.64101E+00,-0.64276E+00, + &-0.64449E+00,-0.64618E+00,-0.64784E+00,-0.64946E+00,-0.65106E+00, + &-0.65263E+00,-0.65417E+00,-0.65569E+00,-0.65718E+00,-0.65865E+00, + &-0.66009E+00,-0.66150E+00,-0.66290E+00,-0.66427E+00,-0.66562E+00, + &-0.66695E+00,-0.66826E+00,-0.66956E+00,-0.67083E+00,-0.67208E+00, + &-0.67332E+00,-0.67454E+00,-0.67574E+00,-0.67692E+00,-0.67809E+00, + &-0.67924E+00,-0.68038E+00,-0.68150E+00,-0.68261E+00,-0.68371E+00, + &-0.68479E+00,-0.68585E+00,-0.68691E+00,-0.68795E+00,-0.68897E+00/ + + DATA (BNC02M (I),I=101,200)/ + &-0.68999E+00,-0.69099E+00,-0.69198E+00,-0.69296E+00,-0.69393E+00, + &-0.69488E+00,-0.69582E+00,-0.69676E+00,-0.69768E+00,-0.69859E+00, + &-0.69949E+00,-0.70038E+00,-0.70126E+00,-0.70213E+00,-0.70299E+00, + &-0.70384E+00,-0.70468E+00,-0.70551E+00,-0.70633E+00,-0.70715E+00, + &-0.70792E+00,-0.70871E+00,-0.70950E+00,-0.71028E+00,-0.71105E+00, + &-0.71181E+00,-0.71257E+00,-0.71331E+00,-0.71405E+00,-0.71477E+00, + &-0.71549E+00,-0.71620E+00,-0.71691E+00,-0.71760E+00,-0.71829E+00, + &-0.71897E+00,-0.71964E+00,-0.72031E+00,-0.72097E+00,-0.72162E+00, + &-0.72226E+00,-0.72290E+00,-0.72353E+00,-0.72415E+00,-0.72477E+00, + &-0.72538E+00,-0.72598E+00,-0.72658E+00,-0.72717E+00,-0.72775E+00, + &-0.72833E+00,-0.72890E+00,-0.72947E+00,-0.73003E+00,-0.73058E+00, + &-0.73113E+00,-0.73168E+00,-0.73221E+00,-0.73274E+00,-0.73327E+00, + &-0.73379E+00,-0.73431E+00,-0.73482E+00,-0.73532E+00,-0.73582E+00, + &-0.73632E+00,-0.73681E+00,-0.73729E+00,-0.73778E+00,-0.73825E+00, + &-0.73872E+00,-0.73919E+00,-0.73965E+00,-0.74011E+00,-0.74056E+00, + &-0.74100E+00,-0.74145E+00,-0.74189E+00,-0.74232E+00,-0.74275E+00, + &-0.74318E+00,-0.74360E+00,-0.74402E+00,-0.74443E+00,-0.74484E+00, + &-0.74524E+00,-0.74564E+00,-0.74604E+00,-0.74644E+00,-0.74683E+00, + &-0.74721E+00,-0.74759E+00,-0.74797E+00,-0.74835E+00,-0.74872E+00, + &-0.74908E+00,-0.74945E+00,-0.74981E+00,-0.75016E+00,-0.75052E+00/ + + DATA (BNC02M (I),I=201,300)/ + &-0.75087E+00,-0.75121E+00,-0.75155E+00,-0.75189E+00,-0.75223E+00, + &-0.75256E+00,-0.75289E+00,-0.75322E+00,-0.75354E+00,-0.75386E+00, + &-0.75418E+00,-0.75449E+00,-0.75480E+00,-0.75511E+00,-0.75542E+00, + &-0.75572E+00,-0.75602E+00,-0.75631E+00,-0.75661E+00,-0.75690E+00, + &-0.75718E+00,-0.75747E+00,-0.75775E+00,-0.75803E+00,-0.75830E+00, + &-0.75858E+00,-0.75885E+00,-0.75912E+00,-0.75938E+00,-0.75964E+00, + &-0.75990E+00,-0.76016E+00,-0.76042E+00,-0.76067E+00,-0.76092E+00, + &-0.76117E+00,-0.76141E+00,-0.76165E+00,-0.76189E+00,-0.76213E+00, + &-0.76237E+00,-0.76260E+00,-0.76283E+00,-0.76306E+00,-0.76328E+00, + &-0.76351E+00,-0.76373E+00,-0.76395E+00,-0.76417E+00,-0.76438E+00, + &-0.76459E+00,-0.76480E+00,-0.76501E+00,-0.76522E+00,-0.76542E+00, + &-0.76562E+00,-0.76582E+00,-0.76602E+00,-0.76621E+00,-0.76641E+00, + &-0.76660E+00,-0.76679E+00,-0.76698E+00,-0.76716E+00,-0.76734E+00, + &-0.76753E+00,-0.76770E+00,-0.76788E+00,-0.76806E+00,-0.76823E+00, + &-0.76840E+00,-0.76857E+00,-0.76874E+00,-0.76891E+00,-0.76907E+00, + &-0.76923E+00,-0.76940E+00,-0.76955E+00,-0.76971E+00,-0.76987E+00, + &-0.77002E+00,-0.77017E+00,-0.77032E+00,-0.77047E+00,-0.77062E+00, + &-0.77076E+00,-0.77091E+00,-0.77105E+00,-0.77119E+00,-0.77133E+00, + &-0.77146E+00,-0.77160E+00,-0.77173E+00,-0.77186E+00,-0.77199E+00, + &-0.77212E+00,-0.77225E+00,-0.77238E+00,-0.77250E+00,-0.77262E+00/ + + DATA (BNC02M (I),I=301,400)/ + &-0.77274E+00,-0.77286E+00,-0.77298E+00,-0.77310E+00,-0.77321E+00, + &-0.77333E+00,-0.77344E+00,-0.77355E+00,-0.77366E+00,-0.77377E+00, + &-0.77387E+00,-0.77398E+00,-0.77408E+00,-0.77418E+00,-0.77428E+00, + &-0.77438E+00,-0.77448E+00,-0.77458E+00,-0.77467E+00,-0.77477E+00, + &-0.77486E+00,-0.77495E+00,-0.77504E+00,-0.77513E+00,-0.77522E+00, + &-0.77530E+00,-0.77539E+00,-0.77547E+00,-0.77555E+00,-0.77563E+00, + &-0.77571E+00,-0.77579E+00,-0.77587E+00,-0.77595E+00,-0.77602E+00, + &-0.77609E+00,-0.77617E+00,-0.77624E+00,-0.77631E+00,-0.77638E+00, + &-0.77644E+00,-0.77651E+00,-0.77657E+00,-0.77664E+00,-0.77670E+00, + &-0.77676E+00,-0.77682E+00,-0.77688E+00,-0.77694E+00,-0.77700E+00, + &-0.77705E+00,-0.77711E+00,-0.77716E+00,-0.77722E+00,-0.77727E+00, + &-0.77732E+00,-0.77737E+00,-0.77742E+00,-0.77746E+00,-0.77751E+00, + &-0.77755E+00,-0.77760E+00,-0.77764E+00,-0.77768E+00,-0.77772E+00, + &-0.77776E+00,-0.77780E+00,-0.77784E+00,-0.77788E+00,-0.77791E+00, + &-0.77795E+00,-0.77798E+00,-0.77802E+00,-0.77805E+00,-0.77808E+00, + &-0.77811E+00,-0.77814E+00,-0.77817E+00,-0.77819E+00,-0.77822E+00, + &-0.77825E+00,-0.77827E+00,-0.77829E+00,-0.77832E+00,-0.77834E+00, + &-0.77836E+00,-0.77838E+00,-0.77840E+00,-0.77841E+00,-0.77843E+00, + &-0.77845E+00,-0.77846E+00,-0.77848E+00,-0.77849E+00,-0.77850E+00, + &-0.77851E+00,-0.77852E+00,-0.77853E+00,-0.77854E+00,-0.77855E+00/ + + DATA (BNC02M (I),I=401,500)/ + &-0.77856E+00,-0.77857E+00,-0.77857E+00,-0.77858E+00,-0.77858E+00, + &-0.77858E+00,-0.77859E+00,-0.77859E+00,-0.77859E+00,-0.77859E+00, + &-0.77859E+00,-0.77859E+00,-0.77858E+00,-0.77858E+00,-0.77858E+00, + &-0.77857E+00,-0.77856E+00,-0.77856E+00,-0.77855E+00,-0.77854E+00, + &-0.77853E+00,-0.77852E+00,-0.77851E+00,-0.77850E+00,-0.77849E+00, + &-0.77848E+00,-0.77847E+00,-0.77845E+00,-0.77844E+00,-0.77842E+00, + &-0.77840E+00,-0.77839E+00,-0.77837E+00,-0.77835E+00,-0.77833E+00, + &-0.77831E+00,-0.77829E+00,-0.77827E+00,-0.77825E+00,-0.77823E+00, + &-0.77820E+00,-0.77818E+00,-0.77815E+00,-0.77813E+00,-0.77810E+00, + &-0.77807E+00,-0.77805E+00,-0.77802E+00,-0.77799E+00,-0.77796E+00, + &-0.77793E+00,-0.77790E+00,-0.77787E+00,-0.77784E+00,-0.77780E+00, + &-0.77777E+00,-0.77773E+00,-0.77770E+00,-0.77766E+00,-0.77763E+00, + &-0.77759E+00,-0.77755E+00,-0.77752E+00,-0.77748E+00,-0.77744E+00, + &-0.77740E+00,-0.77736E+00,-0.77732E+00,-0.77727E+00,-0.77723E+00, + &-0.77719E+00,-0.77714E+00,-0.77710E+00,-0.77706E+00,-0.77701E+00, + &-0.77696E+00,-0.77692E+00,-0.77687E+00,-0.77682E+00,-0.77677E+00, + &-0.77672E+00,-0.77668E+00,-0.77663E+00,-0.77657E+00,-0.77652E+00, + &-0.77647E+00,-0.77642E+00,-0.77637E+00,-0.77631E+00,-0.77626E+00, + &-0.77620E+00,-0.77615E+00,-0.77609E+00,-0.77604E+00,-0.77598E+00, + &-0.77592E+00,-0.77586E+00,-0.77580E+00,-0.77575E+00,-0.77569E+00/ + + DATA (BNC02M (I),I=501,600)/ + &-0.77563E+00,-0.77556E+00,-0.77550E+00,-0.77544E+00,-0.77538E+00, + &-0.77532E+00,-0.77525E+00,-0.77519E+00,-0.77512E+00,-0.77506E+00, + &-0.77499E+00,-0.77493E+00,-0.77486E+00,-0.77479E+00,-0.77473E+00, + &-0.77466E+00,-0.77459E+00,-0.77452E+00,-0.77445E+00,-0.77438E+00, + &-0.77431E+00,-0.77424E+00,-0.77417E+00,-0.77410E+00,-0.77402E+00, + &-0.77395E+00,-0.77388E+00,-0.77380E+00,-0.77373E+00,-0.77365E+00, + &-0.77358E+00,-0.77350E+00,-0.77343E+00,-0.77335E+00,-0.77327E+00, + &-0.77319E+00,-0.77312E+00,-0.77304E+00,-0.77296E+00,-0.77288E+00, + &-0.77280E+00,-0.77272E+00,-0.77264E+00,-0.77256E+00,-0.77247E+00, + &-0.77239E+00,-0.77231E+00,-0.77223E+00,-0.77214E+00,-0.77206E+00, + &-0.77197E+00,-0.77189E+00,-0.77180E+00,-0.77172E+00,-0.77163E+00, + &-0.77154E+00,-0.77146E+00,-0.77137E+00,-0.77128E+00,-0.77119E+00, + &-0.77110E+00,-0.77102E+00,-0.77093E+00,-0.77084E+00,-0.77074E+00, + &-0.77065E+00,-0.77056E+00,-0.77047E+00,-0.77038E+00,-0.77029E+00, + &-0.77019E+00,-0.77010E+00,-0.77001E+00,-0.76991E+00,-0.76982E+00, + &-0.76972E+00,-0.76963E+00,-0.76953E+00,-0.76943E+00,-0.76934E+00, + &-0.76924E+00,-0.76914E+00,-0.76904E+00,-0.76895E+00,-0.76885E+00, + &-0.76875E+00,-0.76865E+00,-0.76855E+00,-0.76845E+00,-0.76835E+00, + &-0.76825E+00,-0.76815E+00,-0.76804E+00,-0.76794E+00,-0.76784E+00, + &-0.76774E+00,-0.76763E+00,-0.76753E+00,-0.76743E+00,-0.76703E+00/ + + DATA (BNC02M (I),I=601,700)/ + &-0.76615E+00,-0.76505E+00,-0.76391E+00,-0.76274E+00,-0.76154E+00, + &-0.76031E+00,-0.75905E+00,-0.75775E+00,-0.75643E+00,-0.75509E+00, + &-0.75371E+00,-0.75231E+00,-0.75089E+00,-0.74944E+00,-0.74797E+00, + &-0.74647E+00,-0.74496E+00,-0.74342E+00,-0.74186E+00,-0.74028E+00, + &-0.73868E+00,-0.73706E+00,-0.73542E+00,-0.73376E+00,-0.73209E+00, + &-0.73040E+00,-0.72869E+00,-0.72696E+00,-0.72522E+00,-0.72346E+00, + &-0.72169E+00,-0.71990E+00,-0.71810E+00,-0.71628E+00,-0.71445E+00, + &-0.71261E+00,-0.71075E+00,-0.70888E+00,-0.70699E+00,-0.70510E+00, + &-0.70319E+00,-0.70127E+00,-0.69934E+00,-0.69739E+00,-0.69544E+00, + &-0.69347E+00,-0.69150E+00,-0.68951E+00,-0.68751E+00,-0.68551E+00, + &-0.68349E+00,-0.68146E+00,-0.67943E+00,-0.67738E+00,-0.67533E+00, + &-0.67326E+00,-0.67119E+00,-0.66911E+00,-0.66702E+00,-0.66493E+00, + &-0.66282E+00,-0.66071E+00,-0.65859E+00,-0.65646E+00,-0.65432E+00, + &-0.65218E+00,-0.65003E+00,-0.64787E+00,-0.64571E+00,-0.64354E+00, + &-0.64136E+00,-0.63917E+00,-0.63698E+00,-0.63478E+00,-0.63258E+00, + &-0.63037E+00,-0.62815E+00,-0.62593E+00,-0.62370E+00,-0.62147E+00, + &-0.61923E+00,-0.61699E+00,-0.61474E+00,-0.61248E+00,-0.61022E+00, + &-0.60795E+00,-0.60568E+00,-0.60341E+00,-0.60113E+00,-0.59884E+00, + &-0.59655E+00,-0.59425E+00,-0.59195E+00,-0.58965E+00,-0.58734E+00, + &-0.58503E+00,-0.58271E+00,-0.58039E+00,-0.57806E+00,-0.57573E+00/ + + DATA (BNC02M(I),I=701,741)/ + &-0.57339E+00,-0.57106E+00,-0.56871E+00,-0.56637E+00,-0.56402E+00, + &-0.56166E+00,-0.55930E+00,-0.55694E+00,-0.55458E+00,-0.55221E+00, + &-0.54984E+00,-0.54746E+00,-0.54508E+00,-0.54270E+00,-0.54031E+00, + &-0.53792E+00,-0.53553E+00,-0.53313E+00,-0.53073E+00,-0.52833E+00, + &-0.52593E+00,-0.52352E+00,-0.52111E+00,-0.51870E+00,-0.51628E+00, + &-0.51386E+00,-0.51144E+00,-0.50901E+00,-0.50658E+00,-0.50415E+00, + &-0.50172E+00,-0.49928E+00,-0.49684E+00,-0.49440E+00,-0.49196E+00, + &-0.48951E+00,-0.48706E+00,-0.48461E+00,-0.48216E+00,-0.47970E+00, + &-0.47725E+00 + & / +C +C *** NaNO3 +C + DATA (BNC03M (I),I= 1,100)/ + &-0.50245E-01,-0.91612E-01,-0.12079E+00,-0.14067E+00,-0.15601E+00, + &-0.16858E+00,-0.17927E+00,-0.18858E+00,-0.19683E+00,-0.20425E+00, + &-0.21100E+00,-0.21718E+00,-0.22289E+00,-0.22819E+00,-0.23314E+00, + &-0.23778E+00,-0.24215E+00,-0.24628E+00,-0.25020E+00,-0.25391E+00, + &-0.25745E+00,-0.26083E+00,-0.26407E+00,-0.26716E+00,-0.27014E+00, + &-0.27300E+00,-0.27575E+00,-0.27840E+00,-0.28095E+00,-0.28343E+00, + &-0.28582E+00,-0.28813E+00,-0.29037E+00,-0.29254E+00,-0.29465E+00, + &-0.29669E+00,-0.29868E+00,-0.30062E+00,-0.30250E+00,-0.30433E+00, + &-0.30611E+00,-0.30785E+00,-0.30954E+00,-0.31119E+00,-0.31281E+00, + &-0.31438E+00,-0.31592E+00,-0.31742E+00,-0.31889E+00,-0.32032E+00, + &-0.32173E+00,-0.32310E+00,-0.32444E+00,-0.32576E+00,-0.32705E+00, + &-0.32832E+00,-0.32955E+00,-0.33077E+00,-0.33196E+00,-0.33313E+00, + &-0.33428E+00,-0.33540E+00,-0.33651E+00,-0.33760E+00,-0.33867E+00, + &-0.33972E+00,-0.34075E+00,-0.34176E+00,-0.34276E+00,-0.34375E+00, + &-0.34472E+00,-0.34567E+00,-0.34661E+00,-0.34754E+00,-0.34845E+00, + &-0.34935E+00,-0.35024E+00,-0.35112E+00,-0.35198E+00,-0.35284E+00, + &-0.35368E+00,-0.35452E+00,-0.35534E+00,-0.35615E+00,-0.35696E+00, + &-0.35775E+00,-0.35854E+00,-0.35932E+00,-0.36009E+00,-0.36085E+00, + &-0.36161E+00,-0.36235E+00,-0.36309E+00,-0.36382E+00,-0.36455E+00, + &-0.36527E+00,-0.36598E+00,-0.36668E+00,-0.36738E+00,-0.36807E+00/ + + DATA (BNC03M (I),I=101,200)/ + &-0.36876E+00,-0.36943E+00,-0.37011E+00,-0.37077E+00,-0.37143E+00, + &-0.37209E+00,-0.37274E+00,-0.37338E+00,-0.37402E+00,-0.37465E+00, + &-0.37528E+00,-0.37590E+00,-0.37652E+00,-0.37713E+00,-0.37773E+00, + &-0.37833E+00,-0.37893E+00,-0.37952E+00,-0.38010E+00,-0.38068E+00, + &-0.38123E+00,-0.38180E+00,-0.38237E+00,-0.38293E+00,-0.38349E+00, + &-0.38404E+00,-0.38459E+00,-0.38513E+00,-0.38567E+00,-0.38621E+00, + &-0.38674E+00,-0.38726E+00,-0.38778E+00,-0.38830E+00,-0.38881E+00, + &-0.38931E+00,-0.38981E+00,-0.39031E+00,-0.39081E+00,-0.39130E+00, + &-0.39178E+00,-0.39226E+00,-0.39274E+00,-0.39321E+00,-0.39368E+00, + &-0.39415E+00,-0.39461E+00,-0.39507E+00,-0.39553E+00,-0.39598E+00, + &-0.39642E+00,-0.39687E+00,-0.39731E+00,-0.39775E+00,-0.39818E+00, + &-0.39861E+00,-0.39904E+00,-0.39946E+00,-0.39988E+00,-0.40030E+00, + &-0.40071E+00,-0.40112E+00,-0.40153E+00,-0.40193E+00,-0.40233E+00, + &-0.40273E+00,-0.40313E+00,-0.40352E+00,-0.40391E+00,-0.40430E+00, + &-0.40468E+00,-0.40506E+00,-0.40544E+00,-0.40582E+00,-0.40619E+00, + &-0.40656E+00,-0.40693E+00,-0.40729E+00,-0.40765E+00,-0.40801E+00, + &-0.40837E+00,-0.40872E+00,-0.40907E+00,-0.40942E+00,-0.40977E+00, + &-0.41011E+00,-0.41046E+00,-0.41080E+00,-0.41113E+00,-0.41147E+00, + &-0.41180E+00,-0.41213E+00,-0.41246E+00,-0.41278E+00,-0.41311E+00, + &-0.41343E+00,-0.41375E+00,-0.41407E+00,-0.41438E+00,-0.41469E+00/ + + DATA (BNC03M (I),I=201,300)/ + &-0.41500E+00,-0.41531E+00,-0.41562E+00,-0.41592E+00,-0.41622E+00, + &-0.41652E+00,-0.41682E+00,-0.41712E+00,-0.41741E+00,-0.41770E+00, + &-0.41799E+00,-0.41828E+00,-0.41857E+00,-0.41885E+00,-0.41914E+00, + &-0.41942E+00,-0.41970E+00,-0.41997E+00,-0.42025E+00,-0.42052E+00, + &-0.42079E+00,-0.42106E+00,-0.42133E+00,-0.42160E+00,-0.42186E+00, + &-0.42213E+00,-0.42239E+00,-0.42265E+00,-0.42290E+00,-0.42316E+00, + &-0.42342E+00,-0.42367E+00,-0.42392E+00,-0.42417E+00,-0.42442E+00, + &-0.42466E+00,-0.42491E+00,-0.42515E+00,-0.42539E+00,-0.42564E+00, + &-0.42587E+00,-0.42611E+00,-0.42635E+00,-0.42658E+00,-0.42681E+00, + &-0.42705E+00,-0.42728E+00,-0.42751E+00,-0.42773E+00,-0.42796E+00, + &-0.42818E+00,-0.42841E+00,-0.42863E+00,-0.42885E+00,-0.42907E+00, + &-0.42928E+00,-0.42950E+00,-0.42971E+00,-0.42993E+00,-0.43014E+00, + &-0.43035E+00,-0.43056E+00,-0.43077E+00,-0.43098E+00,-0.43118E+00, + &-0.43139E+00,-0.43159E+00,-0.43179E+00,-0.43199E+00,-0.43219E+00, + &-0.43239E+00,-0.43259E+00,-0.43278E+00,-0.43298E+00,-0.43317E+00, + &-0.43336E+00,-0.43355E+00,-0.43374E+00,-0.43393E+00,-0.43412E+00, + &-0.43430E+00,-0.43449E+00,-0.43467E+00,-0.43486E+00,-0.43504E+00, + &-0.43522E+00,-0.43540E+00,-0.43558E+00,-0.43576E+00,-0.43593E+00, + &-0.43611E+00,-0.43628E+00,-0.43645E+00,-0.43663E+00,-0.43680E+00, + &-0.43697E+00,-0.43714E+00,-0.43730E+00,-0.43747E+00,-0.43764E+00/ + + DATA (BNC03M (I),I=301,400)/ + &-0.43780E+00,-0.43797E+00,-0.43813E+00,-0.43829E+00,-0.43845E+00, + &-0.43861E+00,-0.43877E+00,-0.43893E+00,-0.43909E+00,-0.43924E+00, + &-0.43940E+00,-0.43955E+00,-0.43971E+00,-0.43986E+00,-0.44001E+00, + &-0.44016E+00,-0.44031E+00,-0.44046E+00,-0.44061E+00,-0.44075E+00, + &-0.44090E+00,-0.44104E+00,-0.44119E+00,-0.44133E+00,-0.44147E+00, + &-0.44161E+00,-0.44176E+00,-0.44190E+00,-0.44203E+00,-0.44217E+00, + &-0.44231E+00,-0.44245E+00,-0.44258E+00,-0.44272E+00,-0.44285E+00, + &-0.44298E+00,-0.44312E+00,-0.44325E+00,-0.44338E+00,-0.44351E+00, + &-0.44364E+00,-0.44377E+00,-0.44389E+00,-0.44402E+00,-0.44415E+00, + &-0.44427E+00,-0.44439E+00,-0.44452E+00,-0.44464E+00,-0.44476E+00, + &-0.44488E+00,-0.44500E+00,-0.44512E+00,-0.44524E+00,-0.44536E+00, + &-0.44548E+00,-0.44560E+00,-0.44571E+00,-0.44583E+00,-0.44594E+00, + &-0.44606E+00,-0.44617E+00,-0.44628E+00,-0.44639E+00,-0.44650E+00, + &-0.44661E+00,-0.44672E+00,-0.44683E+00,-0.44694E+00,-0.44705E+00, + &-0.44716E+00,-0.44726E+00,-0.44737E+00,-0.44747E+00,-0.44758E+00, + &-0.44768E+00,-0.44778E+00,-0.44789E+00,-0.44799E+00,-0.44809E+00, + &-0.44819E+00,-0.44829E+00,-0.44839E+00,-0.44848E+00,-0.44858E+00, + &-0.44868E+00,-0.44878E+00,-0.44887E+00,-0.44897E+00,-0.44906E+00, + &-0.44915E+00,-0.44925E+00,-0.44934E+00,-0.44943E+00,-0.44952E+00, + &-0.44961E+00,-0.44970E+00,-0.44979E+00,-0.44988E+00,-0.44997E+00/ + + DATA (BNC03M (I),I=401,500)/ + &-0.45006E+00,-0.45015E+00,-0.45023E+00,-0.45032E+00,-0.45040E+00, + &-0.45049E+00,-0.45057E+00,-0.45066E+00,-0.45074E+00,-0.45082E+00, + &-0.45091E+00,-0.45099E+00,-0.45107E+00,-0.45115E+00,-0.45123E+00, + &-0.45131E+00,-0.45139E+00,-0.45146E+00,-0.45154E+00,-0.45162E+00, + &-0.45170E+00,-0.45177E+00,-0.45185E+00,-0.45192E+00,-0.45200E+00, + &-0.45207E+00,-0.45214E+00,-0.45222E+00,-0.45229E+00,-0.45236E+00, + &-0.45243E+00,-0.45250E+00,-0.45257E+00,-0.45264E+00,-0.45271E+00, + &-0.45278E+00,-0.45285E+00,-0.45291E+00,-0.45298E+00,-0.45305E+00, + &-0.45311E+00,-0.45318E+00,-0.45325E+00,-0.45331E+00,-0.45337E+00, + &-0.45344E+00,-0.45350E+00,-0.45356E+00,-0.45363E+00,-0.45369E+00, + &-0.45375E+00,-0.45381E+00,-0.45387E+00,-0.45393E+00,-0.45399E+00, + &-0.45405E+00,-0.45411E+00,-0.45417E+00,-0.45422E+00,-0.45428E+00, + &-0.45434E+00,-0.45439E+00,-0.45445E+00,-0.45450E+00,-0.45456E+00, + &-0.45461E+00,-0.45467E+00,-0.45472E+00,-0.45477E+00,-0.45483E+00, + &-0.45488E+00,-0.45493E+00,-0.45498E+00,-0.45503E+00,-0.45508E+00, + &-0.45513E+00,-0.45518E+00,-0.45523E+00,-0.45528E+00,-0.45533E+00, + &-0.45538E+00,-0.45542E+00,-0.45547E+00,-0.45552E+00,-0.45556E+00, + &-0.45561E+00,-0.45566E+00,-0.45570E+00,-0.45575E+00,-0.45579E+00, + &-0.45583E+00,-0.45588E+00,-0.45592E+00,-0.45596E+00,-0.45600E+00, + &-0.45605E+00,-0.45609E+00,-0.45613E+00,-0.45617E+00,-0.45621E+00/ + + DATA (BNC03M (I),I=501,600)/ + &-0.45625E+00,-0.45629E+00,-0.45633E+00,-0.45637E+00,-0.45641E+00, + &-0.45644E+00,-0.45648E+00,-0.45652E+00,-0.45655E+00,-0.45659E+00, + &-0.45663E+00,-0.45666E+00,-0.45670E+00,-0.45673E+00,-0.45677E+00, + &-0.45680E+00,-0.45684E+00,-0.45687E+00,-0.45690E+00,-0.45693E+00, + &-0.45697E+00,-0.45700E+00,-0.45703E+00,-0.45706E+00,-0.45709E+00, + &-0.45712E+00,-0.45715E+00,-0.45718E+00,-0.45721E+00,-0.45724E+00, + &-0.45727E+00,-0.45730E+00,-0.45733E+00,-0.45736E+00,-0.45738E+00, + &-0.45741E+00,-0.45744E+00,-0.45746E+00,-0.45749E+00,-0.45751E+00, + &-0.45754E+00,-0.45757E+00,-0.45759E+00,-0.45761E+00,-0.45764E+00, + &-0.45766E+00,-0.45769E+00,-0.45771E+00,-0.45773E+00,-0.45775E+00, + &-0.45778E+00,-0.45780E+00,-0.45782E+00,-0.45784E+00,-0.45786E+00, + &-0.45788E+00,-0.45790E+00,-0.45792E+00,-0.45794E+00,-0.45796E+00, + &-0.45798E+00,-0.45800E+00,-0.45802E+00,-0.45803E+00,-0.45805E+00, + &-0.45807E+00,-0.45809E+00,-0.45810E+00,-0.45812E+00,-0.45814E+00, + &-0.45815E+00,-0.45817E+00,-0.45818E+00,-0.45820E+00,-0.45821E+00, + &-0.45823E+00,-0.45824E+00,-0.45825E+00,-0.45827E+00,-0.45828E+00, + &-0.45829E+00,-0.45831E+00,-0.45832E+00,-0.45833E+00,-0.45834E+00, + &-0.45835E+00,-0.45836E+00,-0.45838E+00,-0.45839E+00,-0.45840E+00, + &-0.45841E+00,-0.45842E+00,-0.45843E+00,-0.45843E+00,-0.45844E+00, + &-0.45845E+00,-0.45846E+00,-0.45847E+00,-0.45848E+00,-0.45850E+00/ + + DATA (BNC03M (I),I=601,700)/ + &-0.45855E+00,-0.45858E+00,-0.45858E+00,-0.45856E+00,-0.45852E+00, + &-0.45845E+00,-0.45836E+00,-0.45825E+00,-0.45812E+00,-0.45796E+00, + &-0.45779E+00,-0.45759E+00,-0.45738E+00,-0.45715E+00,-0.45690E+00, + &-0.45663E+00,-0.45634E+00,-0.45604E+00,-0.45573E+00,-0.45539E+00, + &-0.45504E+00,-0.45468E+00,-0.45430E+00,-0.45390E+00,-0.45350E+00, + &-0.45307E+00,-0.45264E+00,-0.45219E+00,-0.45173E+00,-0.45126E+00, + &-0.45077E+00,-0.45027E+00,-0.44976E+00,-0.44924E+00,-0.44871E+00, + &-0.44817E+00,-0.44762E+00,-0.44705E+00,-0.44648E+00,-0.44589E+00, + &-0.44530E+00,-0.44470E+00,-0.44408E+00,-0.44346E+00,-0.44283E+00, + &-0.44219E+00,-0.44154E+00,-0.44088E+00,-0.44022E+00,-0.43954E+00, + &-0.43886E+00,-0.43817E+00,-0.43747E+00,-0.43676E+00,-0.43605E+00, + &-0.43533E+00,-0.43460E+00,-0.43387E+00,-0.43313E+00,-0.43238E+00, + &-0.43162E+00,-0.43086E+00,-0.43009E+00,-0.42932E+00,-0.42854E+00, + &-0.42775E+00,-0.42695E+00,-0.42616E+00,-0.42535E+00,-0.42454E+00, + &-0.42372E+00,-0.42290E+00,-0.42207E+00,-0.42124E+00,-0.42040E+00, + &-0.41956E+00,-0.41871E+00,-0.41786E+00,-0.41700E+00,-0.41613E+00, + &-0.41527E+00,-0.41439E+00,-0.41351E+00,-0.41263E+00,-0.41175E+00, + &-0.41085E+00,-0.40996E+00,-0.40906E+00,-0.40815E+00,-0.40724E+00, + &-0.40633E+00,-0.40542E+00,-0.40449E+00,-0.40357E+00,-0.40264E+00, + &-0.40171E+00,-0.40077E+00,-0.39983E+00,-0.39889E+00,-0.39794E+00/ + + DATA (BNC03M(I),I=701,741)/ + &-0.39699E+00,-0.39604E+00,-0.39508E+00,-0.39412E+00,-0.39315E+00, + &-0.39218E+00,-0.39121E+00,-0.39024E+00,-0.38926E+00,-0.38828E+00, + &-0.38729E+00,-0.38630E+00,-0.38531E+00,-0.38432E+00,-0.38332E+00, + &-0.38232E+00,-0.38132E+00,-0.38032E+00,-0.37931E+00,-0.37830E+00, + &-0.37729E+00,-0.37627E+00,-0.37525E+00,-0.37423E+00,-0.37320E+00, + &-0.37218E+00,-0.37115E+00,-0.37012E+00,-0.36908E+00,-0.36804E+00, + &-0.36701E+00,-0.36596E+00,-0.36492E+00,-0.36387E+00,-0.36282E+00, + &-0.36177E+00,-0.36072E+00,-0.35967E+00,-0.35861E+00,-0.35755E+00, + &-0.35649E+00 + & / +C +C *** (NH4)2SO4 +C + DATA (BNC04M (I),I= 1,100)/ + &-0.10031E+00,-0.18257E+00,-0.24033E+00,-0.27955E+00,-0.30969E+00, + &-0.33432E+00,-0.35518E+00,-0.37330E+00,-0.38932E+00,-0.40369E+00, + &-0.41670E+00,-0.42860E+00,-0.43956E+00,-0.44971E+00,-0.45917E+00, + &-0.46801E+00,-0.47632E+00,-0.48414E+00,-0.49154E+00,-0.49856E+00, + &-0.50522E+00,-0.51157E+00,-0.51763E+00,-0.52342E+00,-0.52897E+00, + &-0.53428E+00,-0.53939E+00,-0.54431E+00,-0.54904E+00,-0.55361E+00, + &-0.55801E+00,-0.56226E+00,-0.56638E+00,-0.57036E+00,-0.57421E+00, + &-0.57795E+00,-0.58157E+00,-0.58509E+00,-0.58851E+00,-0.59183E+00, + &-0.59506E+00,-0.59820E+00,-0.60126E+00,-0.60424E+00,-0.60714E+00, + &-0.60997E+00,-0.61273E+00,-0.61542E+00,-0.61805E+00,-0.62062E+00, + &-0.62312E+00,-0.62557E+00,-0.62796E+00,-0.63030E+00,-0.63259E+00, + &-0.63484E+00,-0.63703E+00,-0.63918E+00,-0.64128E+00,-0.64334E+00, + &-0.64536E+00,-0.64734E+00,-0.64928E+00,-0.65119E+00,-0.65306E+00, + &-0.65489E+00,-0.65670E+00,-0.65847E+00,-0.66021E+00,-0.66191E+00, + &-0.66360E+00,-0.66525E+00,-0.66687E+00,-0.66847E+00,-0.67004E+00, + &-0.67159E+00,-0.67312E+00,-0.67462E+00,-0.67610E+00,-0.67756E+00, + &-0.67900E+00,-0.68042E+00,-0.68181E+00,-0.68319E+00,-0.68455E+00, + &-0.68590E+00,-0.68722E+00,-0.68853E+00,-0.68982E+00,-0.69109E+00, + &-0.69235E+00,-0.69360E+00,-0.69483E+00,-0.69604E+00,-0.69724E+00, + &-0.69843E+00,-0.69960E+00,-0.70076E+00,-0.70191E+00,-0.70304E+00/ + + DATA (BNC04M (I),I=101,200)/ + &-0.70417E+00,-0.70527E+00,-0.70637E+00,-0.70746E+00,-0.70853E+00, + &-0.70959E+00,-0.71064E+00,-0.71168E+00,-0.71271E+00,-0.71373E+00, + &-0.71473E+00,-0.71573E+00,-0.71672E+00,-0.71769E+00,-0.71866E+00, + &-0.71961E+00,-0.72056E+00,-0.72150E+00,-0.72242E+00,-0.72334E+00, + &-0.72420E+00,-0.72511E+00,-0.72600E+00,-0.72688E+00,-0.72776E+00, + &-0.72862E+00,-0.72948E+00,-0.73033E+00,-0.73116E+00,-0.73199E+00, + &-0.73282E+00,-0.73363E+00,-0.73443E+00,-0.73523E+00,-0.73602E+00, + &-0.73680E+00,-0.73757E+00,-0.73834E+00,-0.73909E+00,-0.73984E+00, + &-0.74059E+00,-0.74132E+00,-0.74205E+00,-0.74277E+00,-0.74348E+00, + &-0.74419E+00,-0.74489E+00,-0.74559E+00,-0.74627E+00,-0.74695E+00, + &-0.74763E+00,-0.74829E+00,-0.74896E+00,-0.74961E+00,-0.75026E+00, + &-0.75090E+00,-0.75154E+00,-0.75217E+00,-0.75280E+00,-0.75342E+00, + &-0.75403E+00,-0.75464E+00,-0.75524E+00,-0.75584E+00,-0.75643E+00, + &-0.75702E+00,-0.75760E+00,-0.75817E+00,-0.75874E+00,-0.75931E+00, + &-0.75987E+00,-0.76042E+00,-0.76098E+00,-0.76152E+00,-0.76206E+00, + &-0.76260E+00,-0.76313E+00,-0.76366E+00,-0.76418E+00,-0.76470E+00, + &-0.76521E+00,-0.76572E+00,-0.76622E+00,-0.76672E+00,-0.76722E+00, + &-0.76771E+00,-0.76820E+00,-0.76868E+00,-0.76916E+00,-0.76963E+00, + &-0.77010E+00,-0.77057E+00,-0.77103E+00,-0.77149E+00,-0.77194E+00, + &-0.77239E+00,-0.77284E+00,-0.77328E+00,-0.77372E+00,-0.77416E+00/ + + DATA (BNC04M (I),I=201,300)/ + &-0.77459E+00,-0.77502E+00,-0.77544E+00,-0.77587E+00,-0.77628E+00, + &-0.77670E+00,-0.77711E+00,-0.77751E+00,-0.77792E+00,-0.77832E+00, + &-0.77872E+00,-0.77911E+00,-0.77950E+00,-0.77989E+00,-0.78027E+00, + &-0.78065E+00,-0.78103E+00,-0.78140E+00,-0.78178E+00,-0.78214E+00, + &-0.78251E+00,-0.78287E+00,-0.78323E+00,-0.78359E+00,-0.78394E+00, + &-0.78429E+00,-0.78464E+00,-0.78498E+00,-0.78532E+00,-0.78566E+00, + &-0.78600E+00,-0.78633E+00,-0.78666E+00,-0.78699E+00,-0.78732E+00, + &-0.78764E+00,-0.78796E+00,-0.78827E+00,-0.78859E+00,-0.78890E+00, + &-0.78921E+00,-0.78952E+00,-0.78982E+00,-0.79012E+00,-0.79042E+00, + &-0.79072E+00,-0.79101E+00,-0.79130E+00,-0.79159E+00,-0.79188E+00, + &-0.79216E+00,-0.79245E+00,-0.79273E+00,-0.79300E+00,-0.79328E+00, + &-0.79355E+00,-0.79382E+00,-0.79409E+00,-0.79436E+00,-0.79462E+00, + &-0.79488E+00,-0.79514E+00,-0.79540E+00,-0.79566E+00,-0.79591E+00, + &-0.79616E+00,-0.79641E+00,-0.79666E+00,-0.79690E+00,-0.79714E+00, + &-0.79738E+00,-0.79762E+00,-0.79786E+00,-0.79809E+00,-0.79832E+00, + &-0.79855E+00,-0.79878E+00,-0.79901E+00,-0.79923E+00,-0.79946E+00, + &-0.79968E+00,-0.79990E+00,-0.80011E+00,-0.80033E+00,-0.80054E+00, + &-0.80075E+00,-0.80096E+00,-0.80117E+00,-0.80138E+00,-0.80158E+00, + &-0.80178E+00,-0.80198E+00,-0.80218E+00,-0.80238E+00,-0.80258E+00, + &-0.80277E+00,-0.80296E+00,-0.80315E+00,-0.80334E+00,-0.80353E+00/ + + DATA (BNC04M (I),I=301,400)/ + &-0.80371E+00,-0.80390E+00,-0.80408E+00,-0.80426E+00,-0.80444E+00, + &-0.80461E+00,-0.80479E+00,-0.80496E+00,-0.80513E+00,-0.80530E+00, + &-0.80547E+00,-0.80564E+00,-0.80581E+00,-0.80597E+00,-0.80613E+00, + &-0.80630E+00,-0.80646E+00,-0.80661E+00,-0.80677E+00,-0.80693E+00, + &-0.80708E+00,-0.80723E+00,-0.80738E+00,-0.80753E+00,-0.80768E+00, + &-0.80783E+00,-0.80797E+00,-0.80812E+00,-0.80826E+00,-0.80840E+00, + &-0.80854E+00,-0.80868E+00,-0.80881E+00,-0.80895E+00,-0.80908E+00, + &-0.80922E+00,-0.80935E+00,-0.80948E+00,-0.80961E+00,-0.80974E+00, + &-0.80986E+00,-0.80999E+00,-0.81011E+00,-0.81023E+00,-0.81035E+00, + &-0.81047E+00,-0.81059E+00,-0.81071E+00,-0.81082E+00,-0.81094E+00, + &-0.81105E+00,-0.81117E+00,-0.81128E+00,-0.81139E+00,-0.81150E+00, + &-0.81160E+00,-0.81171E+00,-0.81181E+00,-0.81192E+00,-0.81202E+00, + &-0.81212E+00,-0.81222E+00,-0.81232E+00,-0.81242E+00,-0.81252E+00, + &-0.81261E+00,-0.81271E+00,-0.81280E+00,-0.81289E+00,-0.81298E+00, + &-0.81307E+00,-0.81316E+00,-0.81325E+00,-0.81334E+00,-0.81342E+00, + &-0.81351E+00,-0.81359E+00,-0.81368E+00,-0.81376E+00,-0.81384E+00, + &-0.81392E+00,-0.81399E+00,-0.81407E+00,-0.81415E+00,-0.81422E+00, + &-0.81430E+00,-0.81437E+00,-0.81444E+00,-0.81451E+00,-0.81459E+00, + &-0.81465E+00,-0.81472E+00,-0.81479E+00,-0.81486E+00,-0.81492E+00, + &-0.81499E+00,-0.81505E+00,-0.81511E+00,-0.81517E+00,-0.81523E+00/ + + DATA (BNC04M (I),I=401,500)/ + &-0.81529E+00,-0.81535E+00,-0.81541E+00,-0.81547E+00,-0.81552E+00, + &-0.81558E+00,-0.81563E+00,-0.81568E+00,-0.81573E+00,-0.81579E+00, + &-0.81584E+00,-0.81589E+00,-0.81593E+00,-0.81598E+00,-0.81603E+00, + &-0.81607E+00,-0.81612E+00,-0.81616E+00,-0.81621E+00,-0.81625E+00, + &-0.81629E+00,-0.81633E+00,-0.81637E+00,-0.81641E+00,-0.81645E+00, + &-0.81648E+00,-0.81652E+00,-0.81656E+00,-0.81659E+00,-0.81662E+00, + &-0.81666E+00,-0.81669E+00,-0.81672E+00,-0.81675E+00,-0.81678E+00, + &-0.81681E+00,-0.81684E+00,-0.81687E+00,-0.81689E+00,-0.81692E+00, + &-0.81694E+00,-0.81697E+00,-0.81699E+00,-0.81701E+00,-0.81704E+00, + &-0.81706E+00,-0.81708E+00,-0.81710E+00,-0.81711E+00,-0.81713E+00, + &-0.81715E+00,-0.81717E+00,-0.81718E+00,-0.81720E+00,-0.81721E+00, + &-0.81723E+00,-0.81724E+00,-0.81725E+00,-0.81726E+00,-0.81727E+00, + &-0.81728E+00,-0.81729E+00,-0.81730E+00,-0.81731E+00,-0.81732E+00, + &-0.81732E+00,-0.81733E+00,-0.81733E+00,-0.81734E+00,-0.81734E+00, + &-0.81734E+00,-0.81735E+00,-0.81735E+00,-0.81735E+00,-0.81735E+00, + &-0.81735E+00,-0.81735E+00,-0.81734E+00,-0.81734E+00,-0.81734E+00, + &-0.81734E+00,-0.81733E+00,-0.81733E+00,-0.81732E+00,-0.81731E+00, + &-0.81731E+00,-0.81730E+00,-0.81729E+00,-0.81728E+00,-0.81727E+00, + &-0.81726E+00,-0.81725E+00,-0.81724E+00,-0.81723E+00,-0.81721E+00, + &-0.81720E+00,-0.81719E+00,-0.81717E+00,-0.81716E+00,-0.81714E+00/ + + DATA (BNC04M (I),I=501,600)/ + &-0.81712E+00,-0.81711E+00,-0.81709E+00,-0.81707E+00,-0.81705E+00, + &-0.81703E+00,-0.81701E+00,-0.81699E+00,-0.81697E+00,-0.81695E+00, + &-0.81693E+00,-0.81690E+00,-0.81688E+00,-0.81686E+00,-0.81683E+00, + &-0.81681E+00,-0.81678E+00,-0.81675E+00,-0.81673E+00,-0.81670E+00, + &-0.81667E+00,-0.81664E+00,-0.81661E+00,-0.81658E+00,-0.81655E+00, + &-0.81652E+00,-0.81649E+00,-0.81646E+00,-0.81642E+00,-0.81639E+00, + &-0.81636E+00,-0.81632E+00,-0.81629E+00,-0.81625E+00,-0.81622E+00, + &-0.81618E+00,-0.81614E+00,-0.81611E+00,-0.81607E+00,-0.81603E+00, + &-0.81599E+00,-0.81595E+00,-0.81591E+00,-0.81587E+00,-0.81583E+00, + &-0.81579E+00,-0.81575E+00,-0.81570E+00,-0.81566E+00,-0.81562E+00, + &-0.81557E+00,-0.81553E+00,-0.81548E+00,-0.81544E+00,-0.81539E+00, + &-0.81534E+00,-0.81530E+00,-0.81525E+00,-0.81520E+00,-0.81515E+00, + &-0.81510E+00,-0.81505E+00,-0.81500E+00,-0.81495E+00,-0.81490E+00, + &-0.81485E+00,-0.81480E+00,-0.81475E+00,-0.81469E+00,-0.81464E+00, + &-0.81459E+00,-0.81453E+00,-0.81448E+00,-0.81442E+00,-0.81437E+00, + &-0.81431E+00,-0.81425E+00,-0.81420E+00,-0.81414E+00,-0.81408E+00, + &-0.81402E+00,-0.81396E+00,-0.81391E+00,-0.81385E+00,-0.81379E+00, + &-0.81372E+00,-0.81366E+00,-0.81360E+00,-0.81354E+00,-0.81348E+00, + &-0.81341E+00,-0.81335E+00,-0.81329E+00,-0.81322E+00,-0.81316E+00, + &-0.81309E+00,-0.81303E+00,-0.81296E+00,-0.81290E+00,-0.81264E+00/ + + DATA (BNC04M (I),I=601,700)/ + &-0.81207E+00,-0.81133E+00,-0.81056E+00,-0.80975E+00,-0.80890E+00, + &-0.80801E+00,-0.80709E+00,-0.80614E+00,-0.80515E+00,-0.80414E+00, + &-0.80309E+00,-0.80201E+00,-0.80090E+00,-0.79977E+00,-0.79861E+00, + &-0.79742E+00,-0.79620E+00,-0.79496E+00,-0.79370E+00,-0.79241E+00, + &-0.79110E+00,-0.78976E+00,-0.78841E+00,-0.78703E+00,-0.78563E+00, + &-0.78421E+00,-0.78277E+00,-0.78131E+00,-0.77984E+00,-0.77834E+00, + &-0.77683E+00,-0.77529E+00,-0.77374E+00,-0.77218E+00,-0.77060E+00, + &-0.76900E+00,-0.76738E+00,-0.76575E+00,-0.76411E+00,-0.76245E+00, + &-0.76077E+00,-0.75908E+00,-0.75738E+00,-0.75566E+00,-0.75393E+00, + &-0.75219E+00,-0.75044E+00,-0.74867E+00,-0.74689E+00,-0.74510E+00, + &-0.74329E+00,-0.74148E+00,-0.73965E+00,-0.73781E+00,-0.73596E+00, + &-0.73411E+00,-0.73224E+00,-0.73036E+00,-0.72847E+00,-0.72657E+00, + &-0.72466E+00,-0.72274E+00,-0.72081E+00,-0.71887E+00,-0.71692E+00, + &-0.71497E+00,-0.71300E+00,-0.71103E+00,-0.70905E+00,-0.70706E+00, + &-0.70506E+00,-0.70306E+00,-0.70104E+00,-0.69902E+00,-0.69699E+00, + &-0.69496E+00,-0.69291E+00,-0.69086E+00,-0.68880E+00,-0.68674E+00, + &-0.68467E+00,-0.68259E+00,-0.68050E+00,-0.67841E+00,-0.67631E+00, + &-0.67421E+00,-0.67210E+00,-0.66998E+00,-0.66786E+00,-0.66573E+00, + &-0.66359E+00,-0.66145E+00,-0.65930E+00,-0.65715E+00,-0.65499E+00, + &-0.65283E+00,-0.65066E+00,-0.64849E+00,-0.64631E+00,-0.64413E+00/ + + DATA (BNC04M(I),I=701,741)/ + &-0.64194E+00,-0.63974E+00,-0.63755E+00,-0.63534E+00,-0.63313E+00, + &-0.63092E+00,-0.62870E+00,-0.62648E+00,-0.62425E+00,-0.62202E+00, + &-0.61979E+00,-0.61755E+00,-0.61530E+00,-0.61305E+00,-0.61080E+00, + &-0.60854E+00,-0.60628E+00,-0.60402E+00,-0.60175E+00,-0.59948E+00, + &-0.59720E+00,-0.59492E+00,-0.59264E+00,-0.59035E+00,-0.58806E+00, + &-0.58576E+00,-0.58346E+00,-0.58116E+00,-0.57886E+00,-0.57655E+00, + &-0.57424E+00,-0.57192E+00,-0.56960E+00,-0.56728E+00,-0.56496E+00, + &-0.56263E+00,-0.56030E+00,-0.55796E+00,-0.55562E+00,-0.55328E+00, + &-0.55094E+00 + & / +C +C *** NH4NO3 +C + DATA (BNC05M (I),I= 1,100)/ + &-0.50742E-01,-0.93469E-01,-0.12433E+00,-0.14581E+00,-0.16269E+00, + &-0.17676E+00,-0.18891E+00,-0.19965E+00,-0.20931E+00,-0.21811E+00, + &-0.22621E+00,-0.23373E+00,-0.24076E+00,-0.24737E+00,-0.25360E+00, + &-0.25952E+00,-0.26514E+00,-0.27051E+00,-0.27565E+00,-0.28058E+00, + &-0.28532E+00,-0.28989E+00,-0.29429E+00,-0.29855E+00,-0.30267E+00, + &-0.30666E+00,-0.31053E+00,-0.31429E+00,-0.31795E+00,-0.32150E+00, + &-0.32497E+00,-0.32834E+00,-0.33163E+00,-0.33484E+00,-0.33797E+00, + &-0.34103E+00,-0.34402E+00,-0.34694E+00,-0.34980E+00,-0.35260E+00, + &-0.35534E+00,-0.35802E+00,-0.36065E+00,-0.36322E+00,-0.36575E+00, + &-0.36823E+00,-0.37065E+00,-0.37304E+00,-0.37538E+00,-0.37767E+00, + &-0.37993E+00,-0.38215E+00,-0.38433E+00,-0.38647E+00,-0.38857E+00, + &-0.39065E+00,-0.39269E+00,-0.39469E+00,-0.39667E+00,-0.39861E+00, + &-0.40053E+00,-0.40242E+00,-0.40429E+00,-0.40613E+00,-0.40794E+00, + &-0.40973E+00,-0.41150E+00,-0.41324E+00,-0.41497E+00,-0.41668E+00, + &-0.41836E+00,-0.42003E+00,-0.42168E+00,-0.42332E+00,-0.42493E+00, + &-0.42654E+00,-0.42812E+00,-0.42970E+00,-0.43126E+00,-0.43281E+00, + &-0.43434E+00,-0.43587E+00,-0.43738E+00,-0.43888E+00,-0.44037E+00, + &-0.44186E+00,-0.44333E+00,-0.44479E+00,-0.44625E+00,-0.44769E+00, + &-0.44913E+00,-0.45056E+00,-0.45198E+00,-0.45339E+00,-0.45480E+00, + &-0.45619E+00,-0.45758E+00,-0.45897E+00,-0.46034E+00,-0.46171E+00/ + + DATA (BNC05M (I),I=101,200)/ + &-0.46308E+00,-0.46443E+00,-0.46578E+00,-0.46712E+00,-0.46846E+00, + &-0.46979E+00,-0.47111E+00,-0.47242E+00,-0.47373E+00,-0.47503E+00, + &-0.47633E+00,-0.47761E+00,-0.47889E+00,-0.48017E+00,-0.48144E+00, + &-0.48270E+00,-0.48395E+00,-0.48519E+00,-0.48643E+00,-0.48766E+00, + &-0.48879E+00,-0.49002E+00,-0.49124E+00,-0.49245E+00,-0.49366E+00, + &-0.49486E+00,-0.49605E+00,-0.49723E+00,-0.49840E+00,-0.49957E+00, + &-0.50073E+00,-0.50188E+00,-0.50303E+00,-0.50416E+00,-0.50529E+00, + &-0.50642E+00,-0.50753E+00,-0.50864E+00,-0.50975E+00,-0.51084E+00, + &-0.51193E+00,-0.51301E+00,-0.51409E+00,-0.51516E+00,-0.51622E+00, + &-0.51728E+00,-0.51833E+00,-0.51938E+00,-0.52042E+00,-0.52145E+00, + &-0.52247E+00,-0.52350E+00,-0.52451E+00,-0.52552E+00,-0.52652E+00, + &-0.52752E+00,-0.52851E+00,-0.52950E+00,-0.53048E+00,-0.53145E+00, + &-0.53242E+00,-0.53339E+00,-0.53434E+00,-0.53530E+00,-0.53625E+00, + &-0.53719E+00,-0.53813E+00,-0.53906E+00,-0.53999E+00,-0.54091E+00, + &-0.54183E+00,-0.54274E+00,-0.54365E+00,-0.54455E+00,-0.54545E+00, + &-0.54634E+00,-0.54723E+00,-0.54811E+00,-0.54899E+00,-0.54986E+00, + &-0.55073E+00,-0.55160E+00,-0.55246E+00,-0.55332E+00,-0.55417E+00, + &-0.55502E+00,-0.55586E+00,-0.55670E+00,-0.55753E+00,-0.55836E+00, + &-0.55919E+00,-0.56001E+00,-0.56083E+00,-0.56164E+00,-0.56245E+00, + &-0.56325E+00,-0.56405E+00,-0.56485E+00,-0.56565E+00,-0.56643E+00/ + + DATA (BNC05M (I),I=201,300)/ + &-0.56722E+00,-0.56800E+00,-0.56878E+00,-0.56955E+00,-0.57032E+00, + &-0.57109E+00,-0.57185E+00,-0.57261E+00,-0.57336E+00,-0.57411E+00, + &-0.57486E+00,-0.57561E+00,-0.57635E+00,-0.57708E+00,-0.57782E+00, + &-0.57854E+00,-0.57927E+00,-0.57999E+00,-0.58071E+00,-0.58143E+00, + &-0.58214E+00,-0.58285E+00,-0.58356E+00,-0.58426E+00,-0.58496E+00, + &-0.58565E+00,-0.58634E+00,-0.58703E+00,-0.58772E+00,-0.58840E+00, + &-0.58908E+00,-0.58976E+00,-0.59043E+00,-0.59110E+00,-0.59177E+00, + &-0.59243E+00,-0.59309E+00,-0.59375E+00,-0.59441E+00,-0.59506E+00, + &-0.59571E+00,-0.59635E+00,-0.59700E+00,-0.59764E+00,-0.59827E+00, + &-0.59891E+00,-0.59954E+00,-0.60017E+00,-0.60079E+00,-0.60141E+00, + &-0.60203E+00,-0.60265E+00,-0.60327E+00,-0.60388E+00,-0.60449E+00, + &-0.60509E+00,-0.60570E+00,-0.60630E+00,-0.60690E+00,-0.60749E+00, + &-0.60808E+00,-0.60868E+00,-0.60926E+00,-0.60985E+00,-0.61043E+00, + &-0.61101E+00,-0.61159E+00,-0.61216E+00,-0.61274E+00,-0.61331E+00, + &-0.61387E+00,-0.61444E+00,-0.61500E+00,-0.61556E+00,-0.61612E+00, + &-0.61667E+00,-0.61723E+00,-0.61778E+00,-0.61832E+00,-0.61887E+00, + &-0.61941E+00,-0.61995E+00,-0.62049E+00,-0.62103E+00,-0.62156E+00, + &-0.62209E+00,-0.62262E+00,-0.62315E+00,-0.62368E+00,-0.62420E+00, + &-0.62472E+00,-0.62524E+00,-0.62575E+00,-0.62627E+00,-0.62678E+00, + &-0.62729E+00,-0.62780E+00,-0.62830E+00,-0.62880E+00,-0.62931E+00/ + + DATA (BNC05M (I),I=301,400)/ + &-0.62980E+00,-0.63030E+00,-0.63080E+00,-0.63129E+00,-0.63178E+00, + &-0.63227E+00,-0.63275E+00,-0.63324E+00,-0.63372E+00,-0.63420E+00, + &-0.63468E+00,-0.63516E+00,-0.63563E+00,-0.63610E+00,-0.63657E+00, + &-0.63704E+00,-0.63751E+00,-0.63797E+00,-0.63844E+00,-0.63890E+00, + &-0.63936E+00,-0.63981E+00,-0.64027E+00,-0.64072E+00,-0.64117E+00, + &-0.64162E+00,-0.64207E+00,-0.64252E+00,-0.64296E+00,-0.64340E+00, + &-0.64385E+00,-0.64428E+00,-0.64472E+00,-0.64516E+00,-0.64559E+00, + &-0.64602E+00,-0.64645E+00,-0.64688E+00,-0.64731E+00,-0.64773E+00, + &-0.64815E+00,-0.64857E+00,-0.64899E+00,-0.64941E+00,-0.64983E+00, + &-0.65024E+00,-0.65066E+00,-0.65107E+00,-0.65148E+00,-0.65188E+00, + &-0.65229E+00,-0.65269E+00,-0.65310E+00,-0.65350E+00,-0.65390E+00, + &-0.65430E+00,-0.65469E+00,-0.65509E+00,-0.65548E+00,-0.65587E+00, + &-0.65626E+00,-0.65665E+00,-0.65704E+00,-0.65742E+00,-0.65781E+00, + &-0.65819E+00,-0.65857E+00,-0.65895E+00,-0.65933E+00,-0.65971E+00, + &-0.66008E+00,-0.66045E+00,-0.66083E+00,-0.66120E+00,-0.66157E+00, + &-0.66193E+00,-0.66230E+00,-0.66266E+00,-0.66303E+00,-0.66339E+00, + &-0.66375E+00,-0.66411E+00,-0.66447E+00,-0.66482E+00,-0.66518E+00, + &-0.66553E+00,-0.66588E+00,-0.66623E+00,-0.66658E+00,-0.66693E+00, + &-0.66727E+00,-0.66762E+00,-0.66796E+00,-0.66831E+00,-0.66865E+00, + &-0.66899E+00,-0.66932E+00,-0.66966E+00,-0.67000E+00,-0.67033E+00/ + + DATA (BNC05M (I),I=401,500)/ + &-0.67066E+00,-0.67100E+00,-0.67133E+00,-0.67166E+00,-0.67198E+00, + &-0.67231E+00,-0.67263E+00,-0.67296E+00,-0.67328E+00,-0.67360E+00, + &-0.67392E+00,-0.67424E+00,-0.67456E+00,-0.67488E+00,-0.67519E+00, + &-0.67551E+00,-0.67582E+00,-0.67613E+00,-0.67644E+00,-0.67675E+00, + &-0.67706E+00,-0.67736E+00,-0.67767E+00,-0.67797E+00,-0.67828E+00, + &-0.67858E+00,-0.67888E+00,-0.67918E+00,-0.67948E+00,-0.67977E+00, + &-0.68007E+00,-0.68037E+00,-0.68066E+00,-0.68095E+00,-0.68124E+00, + &-0.68153E+00,-0.68182E+00,-0.68211E+00,-0.68240E+00,-0.68268E+00, + &-0.68297E+00,-0.68325E+00,-0.68353E+00,-0.68382E+00,-0.68410E+00, + &-0.68438E+00,-0.68465E+00,-0.68493E+00,-0.68521E+00,-0.68548E+00, + &-0.68576E+00,-0.68603E+00,-0.68630E+00,-0.68657E+00,-0.68684E+00, + &-0.68711E+00,-0.68738E+00,-0.68764E+00,-0.68791E+00,-0.68817E+00, + &-0.68844E+00,-0.68870E+00,-0.68896E+00,-0.68922E+00,-0.68948E+00, + &-0.68974E+00,-0.69000E+00,-0.69025E+00,-0.69051E+00,-0.69076E+00, + &-0.69102E+00,-0.69127E+00,-0.69152E+00,-0.69177E+00,-0.69202E+00, + &-0.69227E+00,-0.69252E+00,-0.69276E+00,-0.69301E+00,-0.69325E+00, + &-0.69350E+00,-0.69374E+00,-0.69398E+00,-0.69422E+00,-0.69446E+00, + &-0.69470E+00,-0.69494E+00,-0.69517E+00,-0.69541E+00,-0.69565E+00, + &-0.69588E+00,-0.69611E+00,-0.69635E+00,-0.69658E+00,-0.69681E+00, + &-0.69704E+00,-0.69727E+00,-0.69749E+00,-0.69772E+00,-0.69795E+00/ + + DATA (BNC05M (I),I=501,600)/ + &-0.69817E+00,-0.69840E+00,-0.69862E+00,-0.69884E+00,-0.69907E+00, + &-0.69929E+00,-0.69951E+00,-0.69973E+00,-0.69994E+00,-0.70016E+00, + &-0.70038E+00,-0.70059E+00,-0.70081E+00,-0.70102E+00,-0.70124E+00, + &-0.70145E+00,-0.70166E+00,-0.70187E+00,-0.70208E+00,-0.70229E+00, + &-0.70250E+00,-0.70271E+00,-0.70291E+00,-0.70312E+00,-0.70332E+00, + &-0.70353E+00,-0.70373E+00,-0.70393E+00,-0.70413E+00,-0.70434E+00, + &-0.70454E+00,-0.70474E+00,-0.70493E+00,-0.70513E+00,-0.70533E+00, + &-0.70552E+00,-0.70572E+00,-0.70592E+00,-0.70611E+00,-0.70630E+00, + &-0.70649E+00,-0.70669E+00,-0.70688E+00,-0.70707E+00,-0.70726E+00, + &-0.70744E+00,-0.70763E+00,-0.70782E+00,-0.70801E+00,-0.70819E+00, + &-0.70838E+00,-0.70856E+00,-0.70874E+00,-0.70893E+00,-0.70911E+00, + &-0.70929E+00,-0.70947E+00,-0.70965E+00,-0.70983E+00,-0.71001E+00, + &-0.71018E+00,-0.71036E+00,-0.71054E+00,-0.71071E+00,-0.71089E+00, + &-0.71106E+00,-0.71123E+00,-0.71141E+00,-0.71158E+00,-0.71175E+00, + &-0.71192E+00,-0.71209E+00,-0.71226E+00,-0.71243E+00,-0.71259E+00, + &-0.71276E+00,-0.71293E+00,-0.71309E+00,-0.71326E+00,-0.71342E+00, + &-0.71359E+00,-0.71375E+00,-0.71391E+00,-0.71407E+00,-0.71423E+00, + &-0.71439E+00,-0.71455E+00,-0.71471E+00,-0.71487E+00,-0.71503E+00, + &-0.71519E+00,-0.71534E+00,-0.71550E+00,-0.71565E+00,-0.71581E+00, + &-0.71596E+00,-0.71611E+00,-0.71627E+00,-0.71642E+00,-0.71698E+00/ + + DATA (BNC05M (I),I=601,700)/ + &-0.71819E+00,-0.71960E+00,-0.72096E+00,-0.72225E+00,-0.72349E+00, + &-0.72467E+00,-0.72581E+00,-0.72689E+00,-0.72792E+00,-0.72891E+00, + &-0.72985E+00,-0.73074E+00,-0.73159E+00,-0.73240E+00,-0.73316E+00, + &-0.73389E+00,-0.73457E+00,-0.73522E+00,-0.73583E+00,-0.73640E+00, + &-0.73694E+00,-0.73744E+00,-0.73791E+00,-0.73835E+00,-0.73875E+00, + &-0.73912E+00,-0.73947E+00,-0.73978E+00,-0.74006E+00,-0.74032E+00, + &-0.74055E+00,-0.74075E+00,-0.74093E+00,-0.74107E+00,-0.74120E+00, + &-0.74130E+00,-0.74137E+00,-0.74142E+00,-0.74145E+00,-0.74146E+00, + &-0.74144E+00,-0.74141E+00,-0.74135E+00,-0.74127E+00,-0.74117E+00, + &-0.74105E+00,-0.74092E+00,-0.74076E+00,-0.74058E+00,-0.74039E+00, + &-0.74018E+00,-0.73995E+00,-0.73971E+00,-0.73945E+00,-0.73917E+00, + &-0.73887E+00,-0.73856E+00,-0.73824E+00,-0.73790E+00,-0.73754E+00, + &-0.73717E+00,-0.73679E+00,-0.73639E+00,-0.73598E+00,-0.73555E+00, + &-0.73512E+00,-0.73466E+00,-0.73420E+00,-0.73372E+00,-0.73324E+00, + &-0.73273E+00,-0.73222E+00,-0.73170E+00,-0.73116E+00,-0.73062E+00, + &-0.73006E+00,-0.72949E+00,-0.72891E+00,-0.72832E+00,-0.72772E+00, + &-0.72711E+00,-0.72649E+00,-0.72587E+00,-0.72523E+00,-0.72458E+00, + &-0.72392E+00,-0.72325E+00,-0.72258E+00,-0.72190E+00,-0.72120E+00, + &-0.72050E+00,-0.71979E+00,-0.71908E+00,-0.71835E+00,-0.71762E+00, + &-0.71687E+00,-0.71613E+00,-0.71537E+00,-0.71460E+00,-0.71383E+00/ + + DATA (BNC05M(I),I=701,741)/ + &-0.71305E+00,-0.71227E+00,-0.71148E+00,-0.71068E+00,-0.70987E+00, + &-0.70906E+00,-0.70824E+00,-0.70741E+00,-0.70658E+00,-0.70574E+00, + &-0.70490E+00,-0.70404E+00,-0.70319E+00,-0.70232E+00,-0.70146E+00, + &-0.70058E+00,-0.69970E+00,-0.69882E+00,-0.69792E+00,-0.69703E+00, + &-0.69613E+00,-0.69522E+00,-0.69431E+00,-0.69339E+00,-0.69247E+00, + &-0.69154E+00,-0.69061E+00,-0.68967E+00,-0.68873E+00,-0.68778E+00, + &-0.68683E+00,-0.68588E+00,-0.68492E+00,-0.68395E+00,-0.68298E+00, + &-0.68201E+00,-0.68103E+00,-0.68005E+00,-0.67907E+00,-0.67808E+00, + &-0.67708E+00 + & / +C +C *** NH4Cl +C + DATA (BNC06M (I),I= 1,100)/ + &-0.49530E-01,-0.88966E-01,-0.11577E+00,-0.13342E+00,-0.14661E+00, + &-0.15709E+00,-0.16574E+00,-0.17306E+00,-0.17936E+00,-0.18486E+00, + &-0.18971E+00,-0.19402E+00,-0.19789E+00,-0.20137E+00,-0.20452E+00, + &-0.20738E+00,-0.20999E+00,-0.21238E+00,-0.21457E+00,-0.21658E+00, + &-0.21843E+00,-0.22014E+00,-0.22171E+00,-0.22317E+00,-0.22451E+00, + &-0.22576E+00,-0.22692E+00,-0.22799E+00,-0.22898E+00,-0.22990E+00, + &-0.23075E+00,-0.23154E+00,-0.23228E+00,-0.23295E+00,-0.23358E+00, + &-0.23417E+00,-0.23470E+00,-0.23520E+00,-0.23566E+00,-0.23608E+00, + &-0.23647E+00,-0.23683E+00,-0.23716E+00,-0.23746E+00,-0.23773E+00, + &-0.23797E+00,-0.23820E+00,-0.23840E+00,-0.23857E+00,-0.23873E+00, + &-0.23887E+00,-0.23899E+00,-0.23909E+00,-0.23918E+00,-0.23925E+00, + &-0.23930E+00,-0.23934E+00,-0.23936E+00,-0.23937E+00,-0.23936E+00, + &-0.23935E+00,-0.23932E+00,-0.23927E+00,-0.23922E+00,-0.23915E+00, + &-0.23907E+00,-0.23898E+00,-0.23888E+00,-0.23877E+00,-0.23864E+00, + &-0.23851E+00,-0.23836E+00,-0.23821E+00,-0.23804E+00,-0.23787E+00, + &-0.23768E+00,-0.23748E+00,-0.23727E+00,-0.23706E+00,-0.23683E+00, + &-0.23659E+00,-0.23635E+00,-0.23609E+00,-0.23582E+00,-0.23555E+00, + &-0.23526E+00,-0.23497E+00,-0.23466E+00,-0.23435E+00,-0.23403E+00, + &-0.23370E+00,-0.23336E+00,-0.23302E+00,-0.23266E+00,-0.23230E+00, + &-0.23193E+00,-0.23155E+00,-0.23116E+00,-0.23076E+00,-0.23036E+00/ + + DATA (BNC06M (I),I=101,200)/ + &-0.22995E+00,-0.22954E+00,-0.22912E+00,-0.22869E+00,-0.22825E+00, + &-0.22781E+00,-0.22737E+00,-0.22692E+00,-0.22646E+00,-0.22600E+00, + &-0.22553E+00,-0.22506E+00,-0.22458E+00,-0.22410E+00,-0.22361E+00, + &-0.22312E+00,-0.22263E+00,-0.22213E+00,-0.22163E+00,-0.22112E+00, + &-0.22068E+00,-0.22017E+00,-0.21964E+00,-0.21912E+00,-0.21859E+00, + &-0.21807E+00,-0.21754E+00,-0.21700E+00,-0.21647E+00,-0.21594E+00, + &-0.21540E+00,-0.21486E+00,-0.21432E+00,-0.21378E+00,-0.21323E+00, + &-0.21269E+00,-0.21214E+00,-0.21159E+00,-0.21104E+00,-0.21049E+00, + &-0.20994E+00,-0.20939E+00,-0.20883E+00,-0.20828E+00,-0.20772E+00, + &-0.20716E+00,-0.20660E+00,-0.20604E+00,-0.20548E+00,-0.20492E+00, + &-0.20435E+00,-0.20379E+00,-0.20322E+00,-0.20266E+00,-0.20209E+00, + &-0.20152E+00,-0.20096E+00,-0.20039E+00,-0.19982E+00,-0.19925E+00, + &-0.19867E+00,-0.19810E+00,-0.19753E+00,-0.19696E+00,-0.19638E+00, + &-0.19581E+00,-0.19523E+00,-0.19466E+00,-0.19408E+00,-0.19351E+00, + &-0.19293E+00,-0.19235E+00,-0.19177E+00,-0.19119E+00,-0.19062E+00, + &-0.19004E+00,-0.18946E+00,-0.18888E+00,-0.18830E+00,-0.18772E+00, + &-0.18714E+00,-0.18656E+00,-0.18597E+00,-0.18539E+00,-0.18481E+00, + &-0.18423E+00,-0.18365E+00,-0.18306E+00,-0.18248E+00,-0.18190E+00, + &-0.18131E+00,-0.18073E+00,-0.18015E+00,-0.17956E+00,-0.17898E+00, + &-0.17840E+00,-0.17781E+00,-0.17723E+00,-0.17665E+00,-0.17606E+00/ + + DATA (BNC06M (I),I=201,300)/ + &-0.17548E+00,-0.17489E+00,-0.17431E+00,-0.17372E+00,-0.17314E+00, + &-0.17256E+00,-0.17197E+00,-0.17139E+00,-0.17080E+00,-0.17022E+00, + &-0.16964E+00,-0.16905E+00,-0.16847E+00,-0.16788E+00,-0.16730E+00, + &-0.16672E+00,-0.16613E+00,-0.16555E+00,-0.16496E+00,-0.16438E+00, + &-0.16380E+00,-0.16321E+00,-0.16263E+00,-0.16205E+00,-0.16146E+00, + &-0.16088E+00,-0.16030E+00,-0.15972E+00,-0.15913E+00,-0.15855E+00, + &-0.15797E+00,-0.15739E+00,-0.15681E+00,-0.15622E+00,-0.15564E+00, + &-0.15506E+00,-0.15448E+00,-0.15390E+00,-0.15332E+00,-0.15274E+00, + &-0.15216E+00,-0.15158E+00,-0.15100E+00,-0.15042E+00,-0.14984E+00, + &-0.14926E+00,-0.14868E+00,-0.14810E+00,-0.14752E+00,-0.14695E+00, + &-0.14637E+00,-0.14579E+00,-0.14521E+00,-0.14464E+00,-0.14406E+00, + &-0.14348E+00,-0.14291E+00,-0.14233E+00,-0.14175E+00,-0.14118E+00, + &-0.14060E+00,-0.14003E+00,-0.13945E+00,-0.13888E+00,-0.13831E+00, + &-0.13773E+00,-0.13716E+00,-0.13658E+00,-0.13601E+00,-0.13544E+00, + &-0.13487E+00,-0.13429E+00,-0.13372E+00,-0.13315E+00,-0.13258E+00, + &-0.13201E+00,-0.13144E+00,-0.13087E+00,-0.13030E+00,-0.12973E+00, + &-0.12916E+00,-0.12859E+00,-0.12802E+00,-0.12746E+00,-0.12689E+00, + &-0.12632E+00,-0.12575E+00,-0.12519E+00,-0.12462E+00,-0.12405E+00, + &-0.12349E+00,-0.12292E+00,-0.12236E+00,-0.12179E+00,-0.12123E+00, + &-0.12066E+00,-0.12010E+00,-0.11954E+00,-0.11897E+00,-0.11841E+00/ + + DATA (BNC06M (I),I=301,400)/ + &-0.11785E+00,-0.11729E+00,-0.11672E+00,-0.11616E+00,-0.11560E+00, + &-0.11504E+00,-0.11448E+00,-0.11392E+00,-0.11336E+00,-0.11280E+00, + &-0.11224E+00,-0.11169E+00,-0.11113E+00,-0.11057E+00,-0.11001E+00, + &-0.10945E+00,-0.10890E+00,-0.10834E+00,-0.10779E+00,-0.10723E+00, + &-0.10668E+00,-0.10612E+00,-0.10557E+00,-0.10501E+00,-0.10446E+00, + &-0.10391E+00,-0.10335E+00,-0.10280E+00,-0.10225E+00,-0.10170E+00, + &-0.10114E+00,-0.10059E+00,-0.10004E+00,-0.99493E-01,-0.98943E-01, + &-0.98393E-01,-0.97844E-01,-0.97295E-01,-0.96747E-01,-0.96199E-01, + &-0.95651E-01,-0.95104E-01,-0.94557E-01,-0.94010E-01,-0.93464E-01, + &-0.92918E-01,-0.92373E-01,-0.91828E-01,-0.91283E-01,-0.90739E-01, + &-0.90195E-01,-0.89652E-01,-0.89109E-01,-0.88566E-01,-0.88023E-01, + &-0.87481E-01,-0.86940E-01,-0.86399E-01,-0.85858E-01,-0.85317E-01, + &-0.84777E-01,-0.84238E-01,-0.83698E-01,-0.83159E-01,-0.82621E-01, + &-0.82083E-01,-0.81545E-01,-0.81007E-01,-0.80470E-01,-0.79934E-01, + &-0.79397E-01,-0.78861E-01,-0.78326E-01,-0.77791E-01,-0.77256E-01, + &-0.76722E-01,-0.76188E-01,-0.75654E-01,-0.75121E-01,-0.74588E-01, + &-0.74055E-01,-0.73523E-01,-0.72992E-01,-0.72460E-01,-0.71929E-01, + &-0.71399E-01,-0.70868E-01,-0.70339E-01,-0.69809E-01,-0.69280E-01, + &-0.68751E-01,-0.68223E-01,-0.67695E-01,-0.67167E-01,-0.66640E-01, + &-0.66113E-01,-0.65587E-01,-0.65061E-01,-0.64535E-01,-0.64010E-01/ + + DATA (BNC06M (I),I=401,500)/ + &-0.63485E-01,-0.62960E-01,-0.62436E-01,-0.61912E-01,-0.61389E-01, + &-0.60866E-01,-0.60343E-01,-0.59821E-01,-0.59299E-01,-0.58777E-01, + &-0.58256E-01,-0.57735E-01,-0.57214E-01,-0.56694E-01,-0.56174E-01, + &-0.55655E-01,-0.55136E-01,-0.54617E-01,-0.54099E-01,-0.53581E-01, + &-0.53064E-01,-0.52547E-01,-0.52030E-01,-0.51513E-01,-0.50997E-01, + &-0.50482E-01,-0.49966E-01,-0.49451E-01,-0.48937E-01,-0.48422E-01, + &-0.47908E-01,-0.47395E-01,-0.46882E-01,-0.46369E-01,-0.45857E-01, + &-0.45345E-01,-0.44833E-01,-0.44321E-01,-0.43811E-01,-0.43300E-01, + &-0.42790E-01,-0.42280E-01,-0.41770E-01,-0.41261E-01,-0.40752E-01, + &-0.40244E-01,-0.39736E-01,-0.39228E-01,-0.38720E-01,-0.38213E-01, + &-0.37707E-01,-0.37200E-01,-0.36694E-01,-0.36189E-01,-0.35684E-01, + &-0.35179E-01,-0.34674E-01,-0.34170E-01,-0.33666E-01,-0.33163E-01, + &-0.32659E-01,-0.32157E-01,-0.31654E-01,-0.31152E-01,-0.30650E-01, + &-0.30149E-01,-0.29648E-01,-0.29147E-01,-0.28647E-01,-0.28147E-01, + &-0.27647E-01,-0.27148E-01,-0.26649E-01,-0.26150E-01,-0.25652E-01, + &-0.25154E-01,-0.24657E-01,-0.24159E-01,-0.23662E-01,-0.23166E-01, + &-0.22670E-01,-0.22174E-01,-0.21678E-01,-0.21183E-01,-0.20688E-01, + &-0.20194E-01,-0.19700E-01,-0.19206E-01,-0.18712E-01,-0.18219E-01, + &-0.17726E-01,-0.17234E-01,-0.16742E-01,-0.16250E-01,-0.15758E-01, + &-0.15267E-01,-0.14777E-01,-0.14286E-01,-0.13796E-01,-0.13306E-01/ + + DATA (BNC06M (I),I=501,600)/ + &-0.12817E-01,-0.12328E-01,-0.11839E-01,-0.11350E-01,-0.10862E-01, + &-0.10374E-01,-0.98870E-02,-0.93998E-02,-0.89130E-02,-0.84266E-02, + &-0.79404E-02,-0.74546E-02,-0.69691E-02,-0.64839E-02,-0.59991E-02, + &-0.55146E-02,-0.50304E-02,-0.45465E-02,-0.40630E-02,-0.35797E-02, + &-0.30969E-02,-0.26142E-02,-0.21320E-02,-0.16501E-02,-0.11685E-02, + &-0.68724E-03,-0.20627E-03, 0.27439E-03, 0.75471E-03, 0.12347E-02, + & 0.17144E-02, 0.21938E-02, 0.26728E-02, 0.31515E-02, 0.36300E-02, + & 0.41080E-02, 0.45858E-02, 0.50633E-02, 0.55405E-02, 0.60173E-02, + & 0.64938E-02, 0.69700E-02, 0.74459E-02, 0.79215E-02, 0.83968E-02, + & 0.88718E-02, 0.93464E-02, 0.98208E-02, 0.10295E-01, 0.10768E-01, + & 0.11242E-01, 0.11715E-01, 0.12188E-01, 0.12660E-01, 0.13132E-01, + & 0.13604E-01, 0.14076E-01, 0.14547E-01, 0.15018E-01, 0.15489E-01, + & 0.15959E-01, 0.16429E-01, 0.16899E-01, 0.17368E-01, 0.17837E-01, + & 0.18306E-01, 0.18775E-01, 0.19243E-01, 0.19711E-01, 0.20179E-01, + & 0.20646E-01, 0.21113E-01, 0.21580E-01, 0.22046E-01, 0.22512E-01, + & 0.22978E-01, 0.23444E-01, 0.23909E-01, 0.24374E-01, 0.24838E-01, + & 0.25303E-01, 0.25767E-01, 0.26231E-01, 0.26694E-01, 0.27157E-01, + & 0.27620E-01, 0.28083E-01, 0.28545E-01, 0.29007E-01, 0.29469E-01, + & 0.29930E-01, 0.30391E-01, 0.30852E-01, 0.31313E-01, 0.31773E-01, + & 0.32233E-01, 0.32693E-01, 0.33152E-01, 0.33611E-01, 0.35330E-01/ + + DATA (BNC06M (I),I=601,700)/ + & 0.39099E-01, 0.43640E-01, 0.48154E-01, 0.52641E-01, 0.57101E-01, + & 0.61535E-01, 0.65943E-01, 0.70325E-01, 0.74682E-01, 0.79014E-01, + & 0.83322E-01, 0.87606E-01, 0.91866E-01, 0.96102E-01, 0.10032E+00, + & 0.10451E+00, 0.10868E+00, 0.11282E+00, 0.11695E+00, 0.12105E+00, + & 0.12514E+00, 0.12920E+00, 0.13324E+00, 0.13726E+00, 0.14127E+00, + & 0.14525E+00, 0.14921E+00, 0.15316E+00, 0.15709E+00, 0.16099E+00, + & 0.16488E+00, 0.16876E+00, 0.17261E+00, 0.17645E+00, 0.18027E+00, + & 0.18407E+00, 0.18786E+00, 0.19163E+00, 0.19538E+00, 0.19912E+00, + & 0.20284E+00, 0.20655E+00, 0.21024E+00, 0.21391E+00, 0.21757E+00, + & 0.22122E+00, 0.22485E+00, 0.22847E+00, 0.23207E+00, 0.23566E+00, + & 0.23924E+00, 0.24280E+00, 0.24634E+00, 0.24988E+00, 0.25340E+00, + & 0.25691E+00, 0.26040E+00, 0.26389E+00, 0.26735E+00, 0.27081E+00, + & 0.27426E+00, 0.27769E+00, 0.28111E+00, 0.28452E+00, 0.28792E+00, + & 0.29130E+00, 0.29468E+00, 0.29804E+00, 0.30139E+00, 0.30473E+00, + & 0.30806E+00, 0.31138E+00, 0.31469E+00, 0.31799E+00, 0.32127E+00, + & 0.32455E+00, 0.32782E+00, 0.33107E+00, 0.33432E+00, 0.33756E+00, + & 0.34078E+00, 0.34400E+00, 0.34721E+00, 0.35040E+00, 0.35359E+00, + & 0.35677E+00, 0.35994E+00, 0.36310E+00, 0.36625E+00, 0.36940E+00, + & 0.37253E+00, 0.37565E+00, 0.37877E+00, 0.38188E+00, 0.38498E+00, + & 0.38807E+00, 0.39115E+00, 0.39422E+00, 0.39729E+00, 0.40035E+00/ + + DATA (BNC06M(I),I=701,741)/ + & 0.40340E+00, 0.40644E+00, 0.40947E+00, 0.41250E+00, 0.41552E+00, + & 0.41853E+00, 0.42153E+00, 0.42453E+00, 0.42752E+00, 0.43050E+00, + & 0.43347E+00, 0.43644E+00, 0.43939E+00, 0.44235E+00, 0.44529E+00, + & 0.44823E+00, 0.45116E+00, 0.45408E+00, 0.45700E+00, 0.45991E+00, + & 0.46281E+00, 0.46571E+00, 0.46860E+00, 0.47148E+00, 0.47436E+00, + & 0.47723E+00, 0.48010E+00, 0.48296E+00, 0.48581E+00, 0.48865E+00, + & 0.49149E+00, 0.49433E+00, 0.49715E+00, 0.49998E+00, 0.50279E+00, + & 0.50560E+00, 0.50840E+00, 0.51120E+00, 0.51399E+00, 0.51678E+00, + & 0.51956E+00 + & / +C +C *** (2H, SO4) +C + DATA (BNC07M (I),I= 1,100)/ + &-0.10013E+00,-0.18189E+00,-0.23903E+00,-0.27766E+00,-0.30724E+00, + &-0.33132E+00,-0.35165E+00,-0.36925E+00,-0.38476E+00,-0.39862E+00, + &-0.41114E+00,-0.42256E+00,-0.43303E+00,-0.44271E+00,-0.45169E+00, + &-0.46007E+00,-0.46792E+00,-0.47529E+00,-0.48224E+00,-0.48881E+00, + &-0.49504E+00,-0.50095E+00,-0.50658E+00,-0.51195E+00,-0.51707E+00, + &-0.52197E+00,-0.52667E+00,-0.53118E+00,-0.53551E+00,-0.53967E+00, + &-0.54368E+00,-0.54754E+00,-0.55127E+00,-0.55486E+00,-0.55834E+00, + &-0.56170E+00,-0.56495E+00,-0.56811E+00,-0.57116E+00,-0.57412E+00, + &-0.57699E+00,-0.57978E+00,-0.58249E+00,-0.58513E+00,-0.58769E+00, + &-0.59018E+00,-0.59261E+00,-0.59497E+00,-0.59727E+00,-0.59951E+00, + &-0.60169E+00,-0.60383E+00,-0.60591E+00,-0.60794E+00,-0.60992E+00, + &-0.61185E+00,-0.61374E+00,-0.61559E+00,-0.61740E+00,-0.61916E+00, + &-0.62089E+00,-0.62258E+00,-0.62424E+00,-0.62586E+00,-0.62744E+00, + &-0.62900E+00,-0.63052E+00,-0.63201E+00,-0.63347E+00,-0.63490E+00, + &-0.63631E+00,-0.63769E+00,-0.63904E+00,-0.64037E+00,-0.64167E+00, + &-0.64295E+00,-0.64420E+00,-0.64544E+00,-0.64665E+00,-0.64784E+00, + &-0.64901E+00,-0.65016E+00,-0.65129E+00,-0.65240E+00,-0.65350E+00, + &-0.65457E+00,-0.65563E+00,-0.65667E+00,-0.65770E+00,-0.65871E+00, + &-0.65970E+00,-0.66068E+00,-0.66164E+00,-0.66259E+00,-0.66352E+00, + &-0.66444E+00,-0.66535E+00,-0.66624E+00,-0.66712E+00,-0.66799E+00/ + + DATA (BNC07M (I),I=101,200)/ + &-0.66884E+00,-0.66968E+00,-0.67051E+00,-0.67133E+00,-0.67214E+00, + &-0.67293E+00,-0.67372E+00,-0.67449E+00,-0.67525E+00,-0.67600E+00, + &-0.67674E+00,-0.67748E+00,-0.67820E+00,-0.67891E+00,-0.67961E+00, + &-0.68030E+00,-0.68098E+00,-0.68165E+00,-0.68232E+00,-0.68297E+00, + &-0.68360E+00,-0.68424E+00,-0.68487E+00,-0.68549E+00,-0.68610E+00, + &-0.68671E+00,-0.68731E+00,-0.68789E+00,-0.68848E+00,-0.68905E+00, + &-0.68961E+00,-0.69017E+00,-0.69072E+00,-0.69126E+00,-0.69180E+00, + &-0.69233E+00,-0.69285E+00,-0.69336E+00,-0.69387E+00,-0.69437E+00, + &-0.69487E+00,-0.69536E+00,-0.69584E+00,-0.69631E+00,-0.69678E+00, + &-0.69724E+00,-0.69770E+00,-0.69815E+00,-0.69860E+00,-0.69904E+00, + &-0.69947E+00,-0.69990E+00,-0.70032E+00,-0.70074E+00,-0.70115E+00, + &-0.70156E+00,-0.70196E+00,-0.70235E+00,-0.70274E+00,-0.70313E+00, + &-0.70351E+00,-0.70389E+00,-0.70426E+00,-0.70463E+00,-0.70499E+00, + &-0.70534E+00,-0.70570E+00,-0.70604E+00,-0.70639E+00,-0.70673E+00, + &-0.70706E+00,-0.70739E+00,-0.70772E+00,-0.70804E+00,-0.70836E+00, + &-0.70867E+00,-0.70898E+00,-0.70928E+00,-0.70958E+00,-0.70988E+00, + &-0.71018E+00,-0.71047E+00,-0.71075E+00,-0.71103E+00,-0.71131E+00, + &-0.71159E+00,-0.71186E+00,-0.71213E+00,-0.71239E+00,-0.71265E+00, + &-0.71291E+00,-0.71316E+00,-0.71341E+00,-0.71366E+00,-0.71390E+00, + &-0.71414E+00,-0.71438E+00,-0.71461E+00,-0.71484E+00,-0.71507E+00/ + + DATA (BNC07M (I),I=201,300)/ + &-0.71529E+00,-0.71552E+00,-0.71573E+00,-0.71595E+00,-0.71616E+00, + &-0.71637E+00,-0.71658E+00,-0.71678E+00,-0.71698E+00,-0.71718E+00, + &-0.71737E+00,-0.71757E+00,-0.71776E+00,-0.71794E+00,-0.71813E+00, + &-0.71831E+00,-0.71849E+00,-0.71866E+00,-0.71884E+00,-0.71901E+00, + &-0.71918E+00,-0.71934E+00,-0.71950E+00,-0.71967E+00,-0.71982E+00, + &-0.71998E+00,-0.72013E+00,-0.72029E+00,-0.72043E+00,-0.72058E+00, + &-0.72073E+00,-0.72087E+00,-0.72101E+00,-0.72114E+00,-0.72128E+00, + &-0.72141E+00,-0.72154E+00,-0.72167E+00,-0.72180E+00,-0.72192E+00, + &-0.72205E+00,-0.72217E+00,-0.72228E+00,-0.72240E+00,-0.72251E+00, + &-0.72263E+00,-0.72274E+00,-0.72284E+00,-0.72295E+00,-0.72305E+00, + &-0.72316E+00,-0.72326E+00,-0.72335E+00,-0.72345E+00,-0.72355E+00, + &-0.72364E+00,-0.72373E+00,-0.72382E+00,-0.72391E+00,-0.72399E+00, + &-0.72407E+00,-0.72416E+00,-0.72424E+00,-0.72432E+00,-0.72439E+00, + &-0.72447E+00,-0.72454E+00,-0.72461E+00,-0.72468E+00,-0.72475E+00, + &-0.72482E+00,-0.72488E+00,-0.72494E+00,-0.72501E+00,-0.72507E+00, + &-0.72513E+00,-0.72518E+00,-0.72524E+00,-0.72529E+00,-0.72534E+00, + &-0.72539E+00,-0.72544E+00,-0.72549E+00,-0.72554E+00,-0.72558E+00, + &-0.72563E+00,-0.72567E+00,-0.72571E+00,-0.72575E+00,-0.72579E+00, + &-0.72582E+00,-0.72586E+00,-0.72589E+00,-0.72592E+00,-0.72595E+00, + &-0.72598E+00,-0.72601E+00,-0.72604E+00,-0.72606E+00,-0.72609E+00/ + + DATA (BNC07M (I),I=301,400)/ + &-0.72611E+00,-0.72613E+00,-0.72615E+00,-0.72617E+00,-0.72619E+00, + &-0.72620E+00,-0.72622E+00,-0.72623E+00,-0.72624E+00,-0.72626E+00, + &-0.72627E+00,-0.72627E+00,-0.72628E+00,-0.72629E+00,-0.72629E+00, + &-0.72630E+00,-0.72630E+00,-0.72630E+00,-0.72630E+00,-0.72630E+00, + &-0.72630E+00,-0.72630E+00,-0.72629E+00,-0.72629E+00,-0.72628E+00, + &-0.72628E+00,-0.72627E+00,-0.72626E+00,-0.72625E+00,-0.72624E+00, + &-0.72622E+00,-0.72621E+00,-0.72619E+00,-0.72618E+00,-0.72616E+00, + &-0.72614E+00,-0.72612E+00,-0.72610E+00,-0.72608E+00,-0.72606E+00, + &-0.72604E+00,-0.72601E+00,-0.72599E+00,-0.72596E+00,-0.72594E+00, + &-0.72591E+00,-0.72588E+00,-0.72585E+00,-0.72582E+00,-0.72579E+00, + &-0.72575E+00,-0.72572E+00,-0.72569E+00,-0.72565E+00,-0.72561E+00, + &-0.72558E+00,-0.72554E+00,-0.72550E+00,-0.72546E+00,-0.72542E+00, + &-0.72538E+00,-0.72533E+00,-0.72529E+00,-0.72524E+00,-0.72520E+00, + &-0.72515E+00,-0.72511E+00,-0.72506E+00,-0.72501E+00,-0.72496E+00, + &-0.72491E+00,-0.72486E+00,-0.72481E+00,-0.72475E+00,-0.72470E+00, + &-0.72464E+00,-0.72459E+00,-0.72453E+00,-0.72448E+00,-0.72442E+00, + &-0.72436E+00,-0.72430E+00,-0.72424E+00,-0.72418E+00,-0.72412E+00, + &-0.72406E+00,-0.72399E+00,-0.72393E+00,-0.72386E+00,-0.72380E+00, + &-0.72373E+00,-0.72367E+00,-0.72360E+00,-0.72353E+00,-0.72346E+00, + &-0.72339E+00,-0.72332E+00,-0.72325E+00,-0.72318E+00,-0.72310E+00/ + + DATA (BNC07M (I),I=401,500)/ + &-0.72303E+00,-0.72296E+00,-0.72288E+00,-0.72281E+00,-0.72273E+00, + &-0.72265E+00,-0.72258E+00,-0.72250E+00,-0.72242E+00,-0.72234E+00, + &-0.72226E+00,-0.72218E+00,-0.72210E+00,-0.72201E+00,-0.72193E+00, + &-0.72185E+00,-0.72176E+00,-0.72168E+00,-0.72159E+00,-0.72151E+00, + &-0.72142E+00,-0.72133E+00,-0.72124E+00,-0.72116E+00,-0.72107E+00, + &-0.72098E+00,-0.72089E+00,-0.72080E+00,-0.72070E+00,-0.72061E+00, + &-0.72052E+00,-0.72042E+00,-0.72033E+00,-0.72024E+00,-0.72014E+00, + &-0.72004E+00,-0.71995E+00,-0.71985E+00,-0.71975E+00,-0.71966E+00, + &-0.71956E+00,-0.71946E+00,-0.71936E+00,-0.71926E+00,-0.71916E+00, + &-0.71905E+00,-0.71895E+00,-0.71885E+00,-0.71875E+00,-0.71864E+00, + &-0.71854E+00,-0.71843E+00,-0.71833E+00,-0.71822E+00,-0.71812E+00, + &-0.71801E+00,-0.71790E+00,-0.71779E+00,-0.71768E+00,-0.71758E+00, + &-0.71747E+00,-0.71736E+00,-0.71724E+00,-0.71713E+00,-0.71702E+00, + &-0.71691E+00,-0.71680E+00,-0.71668E+00,-0.71657E+00,-0.71646E+00, + &-0.71634E+00,-0.71623E+00,-0.71611E+00,-0.71599E+00,-0.71588E+00, + &-0.71576E+00,-0.71564E+00,-0.71552E+00,-0.71541E+00,-0.71529E+00, + &-0.71517E+00,-0.71505E+00,-0.71493E+00,-0.71481E+00,-0.71468E+00, + &-0.71456E+00,-0.71444E+00,-0.71432E+00,-0.71419E+00,-0.71407E+00, + &-0.71395E+00,-0.71382E+00,-0.71370E+00,-0.71357E+00,-0.71345E+00, + &-0.71332E+00,-0.71319E+00,-0.71307E+00,-0.71294E+00,-0.71281E+00/ + + DATA (BNC07M (I),I=501,600)/ + &-0.71268E+00,-0.71255E+00,-0.71242E+00,-0.71229E+00,-0.71216E+00, + &-0.71203E+00,-0.71190E+00,-0.71177E+00,-0.71164E+00,-0.71150E+00, + &-0.71137E+00,-0.71124E+00,-0.71111E+00,-0.71097E+00,-0.71084E+00, + &-0.71070E+00,-0.71057E+00,-0.71043E+00,-0.71030E+00,-0.71016E+00, + &-0.71002E+00,-0.70988E+00,-0.70975E+00,-0.70961E+00,-0.70947E+00, + &-0.70933E+00,-0.70919E+00,-0.70905E+00,-0.70891E+00,-0.70877E+00, + &-0.70863E+00,-0.70849E+00,-0.70835E+00,-0.70821E+00,-0.70807E+00, + &-0.70792E+00,-0.70778E+00,-0.70764E+00,-0.70749E+00,-0.70735E+00, + &-0.70721E+00,-0.70706E+00,-0.70692E+00,-0.70677E+00,-0.70662E+00, + &-0.70648E+00,-0.70633E+00,-0.70618E+00,-0.70604E+00,-0.70589E+00, + &-0.70574E+00,-0.70559E+00,-0.70544E+00,-0.70530E+00,-0.70515E+00, + &-0.70500E+00,-0.70485E+00,-0.70470E+00,-0.70455E+00,-0.70439E+00, + &-0.70424E+00,-0.70409E+00,-0.70394E+00,-0.70379E+00,-0.70363E+00, + &-0.70348E+00,-0.70333E+00,-0.70317E+00,-0.70302E+00,-0.70287E+00, + &-0.70271E+00,-0.70256E+00,-0.70240E+00,-0.70225E+00,-0.70209E+00, + &-0.70193E+00,-0.70178E+00,-0.70162E+00,-0.70146E+00,-0.70131E+00, + &-0.70115E+00,-0.70099E+00,-0.70083E+00,-0.70067E+00,-0.70051E+00, + &-0.70035E+00,-0.70019E+00,-0.70003E+00,-0.69987E+00,-0.69971E+00, + &-0.69955E+00,-0.69939E+00,-0.69923E+00,-0.69907E+00,-0.69891E+00, + &-0.69874E+00,-0.69858E+00,-0.69842E+00,-0.69826E+00,-0.69764E+00/ + + DATA (BNC07M (I),I=601,700)/ + &-0.69627E+00,-0.69459E+00,-0.69289E+00,-0.69115E+00,-0.68939E+00, + &-0.68761E+00,-0.68581E+00,-0.68398E+00,-0.68213E+00,-0.68026E+00, + &-0.67837E+00,-0.67646E+00,-0.67453E+00,-0.67259E+00,-0.67062E+00, + &-0.66864E+00,-0.66664E+00,-0.66463E+00,-0.66260E+00,-0.66055E+00, + &-0.65849E+00,-0.65641E+00,-0.65433E+00,-0.65222E+00,-0.65011E+00, + &-0.64798E+00,-0.64584E+00,-0.64368E+00,-0.64152E+00,-0.63934E+00, + &-0.63715E+00,-0.63495E+00,-0.63274E+00,-0.63052E+00,-0.62829E+00, + &-0.62605E+00,-0.62380E+00,-0.62154E+00,-0.61927E+00,-0.61700E+00, + &-0.61471E+00,-0.61242E+00,-0.61011E+00,-0.60780E+00,-0.60548E+00, + &-0.60316E+00,-0.60082E+00,-0.59848E+00,-0.59613E+00,-0.59378E+00, + &-0.59141E+00,-0.58904E+00,-0.58667E+00,-0.58428E+00,-0.58189E+00, + &-0.57950E+00,-0.57710E+00,-0.57469E+00,-0.57228E+00,-0.56986E+00, + &-0.56743E+00,-0.56500E+00,-0.56257E+00,-0.56013E+00,-0.55768E+00, + &-0.55523E+00,-0.55278E+00,-0.55032E+00,-0.54785E+00,-0.54538E+00, + &-0.54291E+00,-0.54043E+00,-0.53795E+00,-0.53546E+00,-0.53297E+00, + &-0.53047E+00,-0.52797E+00,-0.52547E+00,-0.52296E+00,-0.52045E+00, + &-0.51793E+00,-0.51541E+00,-0.51289E+00,-0.51037E+00,-0.50784E+00, + &-0.50530E+00,-0.50277E+00,-0.50023E+00,-0.49769E+00,-0.49514E+00, + &-0.49259E+00,-0.49004E+00,-0.48749E+00,-0.48493E+00,-0.48237E+00, + &-0.47980E+00,-0.47724E+00,-0.47467E+00,-0.47210E+00,-0.46952E+00/ + + DATA (BNC07M(I),I=701,741)/ + &-0.46694E+00,-0.46436E+00,-0.46178E+00,-0.45920E+00,-0.45661E+00, + &-0.45402E+00,-0.45143E+00,-0.44884E+00,-0.44624E+00,-0.44364E+00, + &-0.44104E+00,-0.43844E+00,-0.43583E+00,-0.43322E+00,-0.43062E+00, + &-0.42800E+00,-0.42539E+00,-0.42278E+00,-0.42016E+00,-0.41754E+00, + &-0.41492E+00,-0.41230E+00,-0.40967E+00,-0.40704E+00,-0.40442E+00, + &-0.40179E+00,-0.39916E+00,-0.39652E+00,-0.39389E+00,-0.39125E+00, + &-0.38861E+00,-0.38597E+00,-0.38333E+00,-0.38069E+00,-0.37805E+00, + &-0.37540E+00,-0.37275E+00,-0.37010E+00,-0.36746E+00,-0.36480E+00, + &-0.36215E+00 + & / +C +C *** (H, HSO4) +C + DATA (BNC08M (I),I= 1,100)/ + &-0.47223E-01,-0.81099E-01,-0.10165E+00,-0.11366E+00,-0.12158E+00, + &-0.12700E+00,-0.13074E+00,-0.13324E+00,-0.13478E+00,-0.13555E+00, + &-0.13569E+00,-0.13529E+00,-0.13443E+00,-0.13316E+00,-0.13154E+00, + &-0.12959E+00,-0.12735E+00,-0.12484E+00,-0.12208E+00,-0.11910E+00, + &-0.11591E+00,-0.11252E+00,-0.10894E+00,-0.10519E+00,-0.10128E+00, + &-0.97205E-01,-0.92986E-01,-0.88626E-01,-0.84132E-01,-0.79512E-01, + &-0.74769E-01,-0.69911E-01,-0.64942E-01,-0.59867E-01,-0.54691E-01, + &-0.49419E-01,-0.44054E-01,-0.38600E-01,-0.33062E-01,-0.27442E-01, + &-0.21746E-01,-0.15975E-01,-0.10133E-01,-0.42230E-02, 0.17517E-02, + & 0.77886E-02, 0.13885E-01, 0.20039E-01, 0.26247E-01, 0.32508E-01, + & 0.38819E-01, 0.45178E-01, 0.51584E-01, 0.58035E-01, 0.64529E-01, + & 0.71064E-01, 0.77640E-01, 0.84256E-01, 0.90910E-01, 0.97601E-01, + & 0.10433E+00, 0.11109E+00, 0.11789E+00, 0.12472E+00, 0.13159E+00, + & 0.13850E+00, 0.14543E+00, 0.15240E+00, 0.15941E+00, 0.16645E+00, + & 0.17353E+00, 0.18064E+00, 0.18778E+00, 0.19496E+00, 0.20218E+00, + & 0.20943E+00, 0.21672E+00, 0.22405E+00, 0.23142E+00, 0.23882E+00, + & 0.24627E+00, 0.25375E+00, 0.26127E+00, 0.26883E+00, 0.27643E+00, + & 0.28407E+00, 0.29175E+00, 0.29947E+00, 0.30724E+00, 0.31503E+00, + & 0.32287E+00, 0.33075E+00, 0.33867E+00, 0.34662E+00, 0.35461E+00, + & 0.36263E+00, 0.37069E+00, 0.37878E+00, 0.38691E+00, 0.39507E+00/ + + DATA (BNC08M (I),I=101,200)/ + & 0.40325E+00, 0.41147E+00, 0.41972E+00, 0.42799E+00, 0.43628E+00, + & 0.44460E+00, 0.45294E+00, 0.46130E+00, 0.46968E+00, 0.47808E+00, + & 0.48650E+00, 0.49492E+00, 0.50337E+00, 0.51182E+00, 0.52028E+00, + & 0.52875E+00, 0.53723E+00, 0.54572E+00, 0.55421E+00, 0.56270E+00, + & 0.57051E+00, 0.57908E+00, 0.58765E+00, 0.59621E+00, 0.60477E+00, + & 0.61331E+00, 0.62184E+00, 0.63037E+00, 0.63888E+00, 0.64739E+00, + & 0.65588E+00, 0.66436E+00, 0.67283E+00, 0.68130E+00, 0.68975E+00, + & 0.69818E+00, 0.70661E+00, 0.71502E+00, 0.72342E+00, 0.73181E+00, + & 0.74019E+00, 0.74855E+00, 0.75690E+00, 0.76524E+00, 0.77356E+00, + & 0.78187E+00, 0.79017E+00, 0.79845E+00, 0.80672E+00, 0.81497E+00, + & 0.82321E+00, 0.83144E+00, 0.83965E+00, 0.84785E+00, 0.85603E+00, + & 0.86420E+00, 0.87235E+00, 0.88049E+00, 0.88861E+00, 0.89672E+00, + & 0.90481E+00, 0.91289E+00, 0.92095E+00, 0.92900E+00, 0.93703E+00, + & 0.94505E+00, 0.95305E+00, 0.96103E+00, 0.96900E+00, 0.97696E+00, + & 0.98490E+00, 0.99282E+00, 0.10007E+01, 0.10086E+01, 0.10165E+01, + & 0.10244E+01, 0.10322E+01, 0.10400E+01, 0.10478E+01, 0.10556E+01, + & 0.10634E+01, 0.10712E+01, 0.10789E+01, 0.10867E+01, 0.10944E+01, + & 0.11021E+01, 0.11098E+01, 0.11175E+01, 0.11251E+01, 0.11328E+01, + & 0.11404E+01, 0.11480E+01, 0.11556E+01, 0.11632E+01, 0.11707E+01, + & 0.11783E+01, 0.11858E+01, 0.11933E+01, 0.12008E+01, 0.12083E+01/ + + DATA (BNC08M (I),I=201,300)/ + & 0.12158E+01, 0.12232E+01, 0.12307E+01, 0.12381E+01, 0.12455E+01, + & 0.12529E+01, 0.12603E+01, 0.12676E+01, 0.12750E+01, 0.12823E+01, + & 0.12896E+01, 0.12969E+01, 0.13042E+01, 0.13115E+01, 0.13187E+01, + & 0.13260E+01, 0.13332E+01, 0.13404E+01, 0.13476E+01, 0.13548E+01, + & 0.13619E+01, 0.13691E+01, 0.13762E+01, 0.13834E+01, 0.13905E+01, + & 0.13975E+01, 0.14046E+01, 0.14117E+01, 0.14187E+01, 0.14258E+01, + & 0.14328E+01, 0.14398E+01, 0.14468E+01, 0.14538E+01, 0.14607E+01, + & 0.14677E+01, 0.14746E+01, 0.14815E+01, 0.14884E+01, 0.14953E+01, + & 0.15022E+01, 0.15091E+01, 0.15159E+01, 0.15228E+01, 0.15296E+01, + & 0.15364E+01, 0.15432E+01, 0.15500E+01, 0.15567E+01, 0.15635E+01, + & 0.15702E+01, 0.15769E+01, 0.15837E+01, 0.15904E+01, 0.15970E+01, + & 0.16037E+01, 0.16104E+01, 0.16170E+01, 0.16237E+01, 0.16303E+01, + & 0.16369E+01, 0.16435E+01, 0.16501E+01, 0.16566E+01, 0.16632E+01, + & 0.16697E+01, 0.16763E+01, 0.16828E+01, 0.16893E+01, 0.16958E+01, + & 0.17022E+01, 0.17087E+01, 0.17152E+01, 0.17216E+01, 0.17280E+01, + & 0.17345E+01, 0.17409E+01, 0.17472E+01, 0.17536E+01, 0.17600E+01, + & 0.17663E+01, 0.17727E+01, 0.17790E+01, 0.17853E+01, 0.17916E+01, + & 0.17979E+01, 0.18042E+01, 0.18105E+01, 0.18167E+01, 0.18230E+01, + & 0.18292E+01, 0.18354E+01, 0.18416E+01, 0.18478E+01, 0.18540E+01, + & 0.18602E+01, 0.18664E+01, 0.18725E+01, 0.18787E+01, 0.18848E+01/ + + DATA (BNC08M (I),I=301,400)/ + & 0.18909E+01, 0.18970E+01, 0.19031E+01, 0.19092E+01, 0.19153E+01, + & 0.19213E+01, 0.19274E+01, 0.19334E+01, 0.19394E+01, 0.19455E+01, + & 0.19515E+01, 0.19575E+01, 0.19634E+01, 0.19694E+01, 0.19754E+01, + & 0.19813E+01, 0.19873E+01, 0.19932E+01, 0.19991E+01, 0.20050E+01, + & 0.20109E+01, 0.20168E+01, 0.20227E+01, 0.20286E+01, 0.20344E+01, + & 0.20403E+01, 0.20461E+01, 0.20519E+01, 0.20577E+01, 0.20635E+01, + & 0.20693E+01, 0.20751E+01, 0.20809E+01, 0.20866E+01, 0.20924E+01, + & 0.20981E+01, 0.21039E+01, 0.21096E+01, 0.21153E+01, 0.21210E+01, + & 0.21267E+01, 0.21324E+01, 0.21380E+01, 0.21437E+01, 0.21494E+01, + & 0.21550E+01, 0.21606E+01, 0.21663E+01, 0.21719E+01, 0.21775E+01, + & 0.21831E+01, 0.21887E+01, 0.21942E+01, 0.21998E+01, 0.22054E+01, + & 0.22109E+01, 0.22164E+01, 0.22220E+01, 0.22275E+01, 0.22330E+01, + & 0.22385E+01, 0.22440E+01, 0.22495E+01, 0.22549E+01, 0.22604E+01, + & 0.22658E+01, 0.22713E+01, 0.22767E+01, 0.22822E+01, 0.22876E+01, + & 0.22930E+01, 0.22984E+01, 0.23038E+01, 0.23092E+01, 0.23145E+01, + & 0.23199E+01, 0.23252E+01, 0.23306E+01, 0.23359E+01, 0.23413E+01, + & 0.23466E+01, 0.23519E+01, 0.23572E+01, 0.23625E+01, 0.23678E+01, + & 0.23730E+01, 0.23783E+01, 0.23836E+01, 0.23888E+01, 0.23941E+01, + & 0.23993E+01, 0.24045E+01, 0.24097E+01, 0.24150E+01, 0.24202E+01, + & 0.24254E+01, 0.24305E+01, 0.24357E+01, 0.24409E+01, 0.24460E+01/ + + DATA (BNC08M (I),I=401,500)/ + & 0.24512E+01, 0.24563E+01, 0.24615E+01, 0.24666E+01, 0.24717E+01, + & 0.24768E+01, 0.24819E+01, 0.24870E+01, 0.24921E+01, 0.24972E+01, + & 0.25023E+01, 0.25073E+01, 0.25124E+01, 0.25174E+01, 0.25225E+01, + & 0.25275E+01, 0.25325E+01, 0.25375E+01, 0.25426E+01, 0.25476E+01, + & 0.25526E+01, 0.25575E+01, 0.25625E+01, 0.25675E+01, 0.25725E+01, + & 0.25774E+01, 0.25824E+01, 0.25873E+01, 0.25922E+01, 0.25972E+01, + & 0.26021E+01, 0.26070E+01, 0.26119E+01, 0.26168E+01, 0.26217E+01, + & 0.26266E+01, 0.26314E+01, 0.26363E+01, 0.26412E+01, 0.26460E+01, + & 0.26509E+01, 0.26557E+01, 0.26605E+01, 0.26653E+01, 0.26702E+01, + & 0.26750E+01, 0.26798E+01, 0.26846E+01, 0.26894E+01, 0.26941E+01, + & 0.26989E+01, 0.27037E+01, 0.27084E+01, 0.27132E+01, 0.27179E+01, + & 0.27227E+01, 0.27274E+01, 0.27321E+01, 0.27369E+01, 0.27416E+01, + & 0.27463E+01, 0.27510E+01, 0.27557E+01, 0.27604E+01, 0.27650E+01, + & 0.27697E+01, 0.27744E+01, 0.27790E+01, 0.27837E+01, 0.27883E+01, + & 0.27930E+01, 0.27976E+01, 0.28022E+01, 0.28068E+01, 0.28115E+01, + & 0.28161E+01, 0.28207E+01, 0.28253E+01, 0.28298E+01, 0.28344E+01, + & 0.28390E+01, 0.28436E+01, 0.28481E+01, 0.28527E+01, 0.28572E+01, + & 0.28618E+01, 0.28663E+01, 0.28708E+01, 0.28754E+01, 0.28799E+01, + & 0.28844E+01, 0.28889E+01, 0.28934E+01, 0.28979E+01, 0.29024E+01, + & 0.29068E+01, 0.29113E+01, 0.29158E+01, 0.29203E+01, 0.29247E+01/ + + DATA (BNC08M (I),I=501,600)/ + & 0.29292E+01, 0.29336E+01, 0.29380E+01, 0.29425E+01, 0.29469E+01, + & 0.29513E+01, 0.29557E+01, 0.29601E+01, 0.29645E+01, 0.29689E+01, + & 0.29733E+01, 0.29777E+01, 0.29821E+01, 0.29865E+01, 0.29908E+01, + & 0.29952E+01, 0.29995E+01, 0.30039E+01, 0.30082E+01, 0.30126E+01, + & 0.30169E+01, 0.30212E+01, 0.30255E+01, 0.30299E+01, 0.30342E+01, + & 0.30385E+01, 0.30428E+01, 0.30471E+01, 0.30514E+01, 0.30556E+01, + & 0.30599E+01, 0.30642E+01, 0.30684E+01, 0.30727E+01, 0.30770E+01, + & 0.30812E+01, 0.30854E+01, 0.30897E+01, 0.30939E+01, 0.30981E+01, + & 0.31024E+01, 0.31066E+01, 0.31108E+01, 0.31150E+01, 0.31192E+01, + & 0.31234E+01, 0.31276E+01, 0.31317E+01, 0.31359E+01, 0.31401E+01, + & 0.31443E+01, 0.31484E+01, 0.31526E+01, 0.31567E+01, 0.31609E+01, + & 0.31650E+01, 0.31692E+01, 0.31733E+01, 0.31774E+01, 0.31815E+01, + & 0.31856E+01, 0.31898E+01, 0.31939E+01, 0.31980E+01, 0.32021E+01, + & 0.32061E+01, 0.32102E+01, 0.32143E+01, 0.32184E+01, 0.32224E+01, + & 0.32265E+01, 0.32306E+01, 0.32346E+01, 0.32387E+01, 0.32427E+01, + & 0.32468E+01, 0.32508E+01, 0.32548E+01, 0.32588E+01, 0.32629E+01, + & 0.32669E+01, 0.32709E+01, 0.32749E+01, 0.32789E+01, 0.32829E+01, + & 0.32869E+01, 0.32909E+01, 0.32948E+01, 0.32988E+01, 0.33028E+01, + & 0.33068E+01, 0.33107E+01, 0.33147E+01, 0.33186E+01, 0.33226E+01, + & 0.33265E+01, 0.33304E+01, 0.33344E+01, 0.33383E+01, 0.33530E+01/ + + DATA (BNC08M (I),I=601,700)/ + & 0.33851E+01, 0.34236E+01, 0.34616E+01, 0.34992E+01, 0.35364E+01, + & 0.35732E+01, 0.36095E+01, 0.36455E+01, 0.36811E+01, 0.37163E+01, + & 0.37511E+01, 0.37856E+01, 0.38198E+01, 0.38535E+01, 0.38870E+01, + & 0.39201E+01, 0.39529E+01, 0.39854E+01, 0.40175E+01, 0.40494E+01, + & 0.40809E+01, 0.41122E+01, 0.41432E+01, 0.41738E+01, 0.42043E+01, + & 0.42344E+01, 0.42643E+01, 0.42939E+01, 0.43232E+01, 0.43523E+01, + & 0.43812E+01, 0.44098E+01, 0.44382E+01, 0.44663E+01, 0.44942E+01, + & 0.45219E+01, 0.45494E+01, 0.45766E+01, 0.46036E+01, 0.46304E+01, + & 0.46570E+01, 0.46834E+01, 0.47096E+01, 0.47356E+01, 0.47614E+01, + & 0.47870E+01, 0.48124E+01, 0.48377E+01, 0.48627E+01, 0.48876E+01, + & 0.49122E+01, 0.49368E+01, 0.49611E+01, 0.49853E+01, 0.50093E+01, + & 0.50331E+01, 0.50568E+01, 0.50803E+01, 0.51036E+01, 0.51268E+01, + & 0.51499E+01, 0.51728E+01, 0.51955E+01, 0.52181E+01, 0.52406E+01, + & 0.52629E+01, 0.52850E+01, 0.53071E+01, 0.53290E+01, 0.53507E+01, + & 0.53723E+01, 0.53938E+01, 0.54152E+01, 0.54364E+01, 0.54575E+01, + & 0.54785E+01, 0.54993E+01, 0.55200E+01, 0.55406E+01, 0.55611E+01, + & 0.55815E+01, 0.56017E+01, 0.56219E+01, 0.56419E+01, 0.56618E+01, + & 0.56816E+01, 0.57013E+01, 0.57209E+01, 0.57404E+01, 0.57597E+01, + & 0.57790E+01, 0.57982E+01, 0.58172E+01, 0.58362E+01, 0.58550E+01, + & 0.58738E+01, 0.58925E+01, 0.59110E+01, 0.59295E+01, 0.59479E+01/ + + DATA (BNC08M(I),I=701,741)/ + & 0.59661E+01, 0.59843E+01, 0.60024E+01, 0.60204E+01, 0.60384E+01, + & 0.60562E+01, 0.60739E+01, 0.60916E+01, 0.61091E+01, 0.61266E+01, + & 0.61440E+01, 0.61614E+01, 0.61786E+01, 0.61957E+01, 0.62128E+01, + & 0.62298E+01, 0.62467E+01, 0.62636E+01, 0.62803E+01, 0.62970E+01, + & 0.63136E+01, 0.63301E+01, 0.63466E+01, 0.63630E+01, 0.63793E+01, + & 0.63955E+01, 0.64117E+01, 0.64278E+01, 0.64438E+01, 0.64598E+01, + & 0.64757E+01, 0.64915E+01, 0.65073E+01, 0.65229E+01, 0.65386E+01, + & 0.65541E+01, 0.65696E+01, 0.65850E+01, 0.66004E+01, 0.66157E+01, + & 0.66309E+01 + & / +C +C *** NH4HSO4 +C + DATA (BNC09M (I),I= 1,100)/ + &-0.49220E-01,-0.88125E-01,-0.11455E+00,-0.13197E+00,-0.14502E+00, + &-0.15542E+00,-0.16401E+00,-0.17127E+00,-0.17752E+00,-0.18296E+00, + &-0.18774E+00,-0.19197E+00,-0.19572E+00,-0.19907E+00,-0.20206E+00, + &-0.20473E+00,-0.20712E+00,-0.20925E+00,-0.21115E+00,-0.21284E+00, + &-0.21433E+00,-0.21563E+00,-0.21677E+00,-0.21775E+00,-0.21858E+00, + &-0.21927E+00,-0.21983E+00,-0.22027E+00,-0.22058E+00,-0.22079E+00, + &-0.22089E+00,-0.22088E+00,-0.22078E+00,-0.22058E+00,-0.22030E+00, + &-0.21992E+00,-0.21947E+00,-0.21894E+00,-0.21833E+00,-0.21764E+00, + &-0.21689E+00,-0.21607E+00,-0.21519E+00,-0.21424E+00,-0.21323E+00, + &-0.21216E+00,-0.21104E+00,-0.20986E+00,-0.20863E+00,-0.20735E+00, + &-0.20602E+00,-0.20464E+00,-0.20322E+00,-0.20175E+00,-0.20025E+00, + &-0.19870E+00,-0.19711E+00,-0.19548E+00,-0.19382E+00,-0.19212E+00, + &-0.19038E+00,-0.18862E+00,-0.18681E+00,-0.18498E+00,-0.18311E+00, + &-0.18122E+00,-0.17929E+00,-0.17734E+00,-0.17536E+00,-0.17334E+00, + &-0.17131E+00,-0.16924E+00,-0.16715E+00,-0.16503E+00,-0.16289E+00, + &-0.16072E+00,-0.15853E+00,-0.15631E+00,-0.15406E+00,-0.15180E+00, + &-0.14951E+00,-0.14719E+00,-0.14486E+00,-0.14250E+00,-0.14011E+00, + &-0.13771E+00,-0.13528E+00,-0.13283E+00,-0.13036E+00,-0.12787E+00, + &-0.12536E+00,-0.12283E+00,-0.12028E+00,-0.11771E+00,-0.11512E+00, + &-0.11251E+00,-0.10988E+00,-0.10724E+00,-0.10458E+00,-0.10191E+00/ + + DATA (BNC09M (I),I=101,200)/ + &-0.99221E-01,-0.96517E-01,-0.93798E-01,-0.91067E-01,-0.88323E-01, + &-0.85567E-01,-0.82800E-01,-0.80022E-01,-0.77234E-01,-0.74437E-01, + &-0.71631E-01,-0.68817E-01,-0.65996E-01,-0.63168E-01,-0.60334E-01, + &-0.57495E-01,-0.54651E-01,-0.51802E-01,-0.48950E-01,-0.46094E-01, + &-0.43478E-01,-0.40589E-01,-0.37702E-01,-0.34815E-01,-0.31930E-01, + &-0.29047E-01,-0.26165E-01,-0.23286E-01,-0.20408E-01,-0.17533E-01, + &-0.14660E-01,-0.11790E-01,-0.89226E-02,-0.60582E-02,-0.31967E-02, + &-0.33866E-03, 0.25164E-02, 0.53678E-02, 0.82159E-02, 0.11060E-01, + & 0.13901E-01, 0.16738E-01, 0.19571E-01, 0.22399E-01, 0.25224E-01, + & 0.28045E-01, 0.30861E-01, 0.33673E-01, 0.36481E-01, 0.39284E-01, + & 0.42083E-01, 0.44877E-01, 0.47667E-01, 0.50452E-01, 0.53232E-01, + & 0.56007E-01, 0.58778E-01, 0.61543E-01, 0.64304E-01, 0.67060E-01, + & 0.69811E-01, 0.72557E-01, 0.75298E-01, 0.78034E-01, 0.80765E-01, + & 0.83490E-01, 0.86211E-01, 0.88926E-01, 0.91637E-01, 0.94342E-01, + & 0.97042E-01, 0.99736E-01, 0.10243E+00, 0.10511E+00, 0.10779E+00, + & 0.11046E+00, 0.11313E+00, 0.11579E+00, 0.11845E+00, 0.12111E+00, + & 0.12375E+00, 0.12639E+00, 0.12903E+00, 0.13166E+00, 0.13429E+00, + & 0.13691E+00, 0.13953E+00, 0.14214E+00, 0.14474E+00, 0.14734E+00, + & 0.14994E+00, 0.15253E+00, 0.15511E+00, 0.15769E+00, 0.16026E+00, + & 0.16283E+00, 0.16540E+00, 0.16795E+00, 0.17051E+00, 0.17305E+00/ + + DATA (BNC09M (I),I=201,300)/ + & 0.17560E+00, 0.17814E+00, 0.18067E+00, 0.18319E+00, 0.18572E+00, + & 0.18823E+00, 0.19075E+00, 0.19325E+00, 0.19575E+00, 0.19825E+00, + & 0.20074E+00, 0.20323E+00, 0.20571E+00, 0.20819E+00, 0.21066E+00, + & 0.21313E+00, 0.21559E+00, 0.21805E+00, 0.22050E+00, 0.22294E+00, + & 0.22539E+00, 0.22782E+00, 0.23026E+00, 0.23268E+00, 0.23511E+00, + & 0.23752E+00, 0.23994E+00, 0.24235E+00, 0.24475E+00, 0.24715E+00, + & 0.24954E+00, 0.25193E+00, 0.25432E+00, 0.25670E+00, 0.25907E+00, + & 0.26144E+00, 0.26381E+00, 0.26617E+00, 0.26853E+00, 0.27088E+00, + & 0.27323E+00, 0.27557E+00, 0.27791E+00, 0.28024E+00, 0.28257E+00, + & 0.28490E+00, 0.28722E+00, 0.28954E+00, 0.29185E+00, 0.29416E+00, + & 0.29646E+00, 0.29876E+00, 0.30105E+00, 0.30334E+00, 0.30563E+00, + & 0.30791E+00, 0.31019E+00, 0.31246E+00, 0.31473E+00, 0.31699E+00, + & 0.31925E+00, 0.32151E+00, 0.32376E+00, 0.32601E+00, 0.32825E+00, + & 0.33049E+00, 0.33273E+00, 0.33496E+00, 0.33718E+00, 0.33941E+00, + & 0.34162E+00, 0.34384E+00, 0.34605E+00, 0.34826E+00, 0.35046E+00, + & 0.35266E+00, 0.35485E+00, 0.35704E+00, 0.35923E+00, 0.36141E+00, + & 0.36359E+00, 0.36577E+00, 0.36794E+00, 0.37010E+00, 0.37227E+00, + & 0.37443E+00, 0.37658E+00, 0.37874E+00, 0.38088E+00, 0.38303E+00, + & 0.38517E+00, 0.38731E+00, 0.38944E+00, 0.39157E+00, 0.39369E+00, + & 0.39582E+00, 0.39793E+00, 0.40005E+00, 0.40216E+00, 0.40427E+00/ + + DATA (BNC09M (I),I=301,400)/ + & 0.40637E+00, 0.40847E+00, 0.41057E+00, 0.41266E+00, 0.41475E+00, + & 0.41684E+00, 0.41892E+00, 0.42100E+00, 0.42307E+00, 0.42514E+00, + & 0.42721E+00, 0.42928E+00, 0.43134E+00, 0.43339E+00, 0.43545E+00, + & 0.43750E+00, 0.43955E+00, 0.44159E+00, 0.44363E+00, 0.44567E+00, + & 0.44770E+00, 0.44973E+00, 0.45176E+00, 0.45378E+00, 0.45581E+00, + & 0.45782E+00, 0.45984E+00, 0.46185E+00, 0.46385E+00, 0.46586E+00, + & 0.46786E+00, 0.46986E+00, 0.47185E+00, 0.47384E+00, 0.47583E+00, + & 0.47782E+00, 0.47980E+00, 0.48178E+00, 0.48375E+00, 0.48572E+00, + & 0.48769E+00, 0.48966E+00, 0.49162E+00, 0.49358E+00, 0.49554E+00, + & 0.49749E+00, 0.49944E+00, 0.50139E+00, 0.50333E+00, 0.50528E+00, + & 0.50721E+00, 0.50915E+00, 0.51108E+00, 0.51301E+00, 0.51494E+00, + & 0.51686E+00, 0.51878E+00, 0.52070E+00, 0.52261E+00, 0.52453E+00, + & 0.52643E+00, 0.52834E+00, 0.53024E+00, 0.53214E+00, 0.53404E+00, + & 0.53593E+00, 0.53782E+00, 0.53971E+00, 0.54160E+00, 0.54348E+00, + & 0.54536E+00, 0.54724E+00, 0.54911E+00, 0.55099E+00, 0.55285E+00, + & 0.55472E+00, 0.55658E+00, 0.55844E+00, 0.56030E+00, 0.56216E+00, + & 0.56401E+00, 0.56586E+00, 0.56770E+00, 0.56955E+00, 0.57139E+00, + & 0.57323E+00, 0.57507E+00, 0.57690E+00, 0.57873E+00, 0.58056E+00, + & 0.58238E+00, 0.58421E+00, 0.58603E+00, 0.58784E+00, 0.58966E+00, + & 0.59147E+00, 0.59328E+00, 0.59509E+00, 0.59689E+00, 0.59869E+00/ + + DATA (BNC09M (I),I=401,500)/ + & 0.60049E+00, 0.60229E+00, 0.60408E+00, 0.60588E+00, 0.60766E+00, + & 0.60945E+00, 0.61124E+00, 0.61302E+00, 0.61480E+00, 0.61657E+00, + & 0.61835E+00, 0.62012E+00, 0.62189E+00, 0.62366E+00, 0.62542E+00, + & 0.62718E+00, 0.62894E+00, 0.63070E+00, 0.63245E+00, 0.63421E+00, + & 0.63596E+00, 0.63770E+00, 0.63945E+00, 0.64119E+00, 0.64293E+00, + & 0.64467E+00, 0.64640E+00, 0.64814E+00, 0.64987E+00, 0.65160E+00, + & 0.65332E+00, 0.65505E+00, 0.65677E+00, 0.65849E+00, 0.66020E+00, + & 0.66192E+00, 0.66363E+00, 0.66534E+00, 0.66705E+00, 0.66875E+00, + & 0.67046E+00, 0.67216E+00, 0.67386E+00, 0.67555E+00, 0.67725E+00, + & 0.67894E+00, 0.68063E+00, 0.68232E+00, 0.68400E+00, 0.68568E+00, + & 0.68737E+00, 0.68904E+00, 0.69072E+00, 0.69240E+00, 0.69407E+00, + & 0.69574E+00, 0.69741E+00, 0.69907E+00, 0.70073E+00, 0.70240E+00, + & 0.70405E+00, 0.70571E+00, 0.70737E+00, 0.70902E+00, 0.71067E+00, + & 0.71232E+00, 0.71397E+00, 0.71561E+00, 0.71725E+00, 0.71889E+00, + & 0.72053E+00, 0.72217E+00, 0.72380E+00, 0.72543E+00, 0.72706E+00, + & 0.72869E+00, 0.73032E+00, 0.73194E+00, 0.73356E+00, 0.73518E+00, + & 0.73680E+00, 0.73842E+00, 0.74003E+00, 0.74164E+00, 0.74325E+00, + & 0.74486E+00, 0.74646E+00, 0.74807E+00, 0.74967E+00, 0.75127E+00, + & 0.75287E+00, 0.75446E+00, 0.75606E+00, 0.75765E+00, 0.75924E+00, + & 0.76083E+00, 0.76241E+00, 0.76400E+00, 0.76558E+00, 0.76716E+00/ + + DATA (BNC09M (I),I=501,600)/ + & 0.76874E+00, 0.77032E+00, 0.77189E+00, 0.77346E+00, 0.77503E+00, + & 0.77660E+00, 0.77817E+00, 0.77973E+00, 0.78130E+00, 0.78286E+00, + & 0.78442E+00, 0.78598E+00, 0.78753E+00, 0.78909E+00, 0.79064E+00, + & 0.79219E+00, 0.79374E+00, 0.79529E+00, 0.79683E+00, 0.79837E+00, + & 0.79991E+00, 0.80145E+00, 0.80299E+00, 0.80453E+00, 0.80606E+00, + & 0.80759E+00, 0.80912E+00, 0.81065E+00, 0.81218E+00, 0.81371E+00, + & 0.81523E+00, 0.81675E+00, 0.81827E+00, 0.81979E+00, 0.82131E+00, + & 0.82282E+00, 0.82433E+00, 0.82584E+00, 0.82735E+00, 0.82886E+00, + & 0.83037E+00, 0.83187E+00, 0.83337E+00, 0.83487E+00, 0.83637E+00, + & 0.83787E+00, 0.83937E+00, 0.84086E+00, 0.84235E+00, 0.84384E+00, + & 0.84533E+00, 0.84682E+00, 0.84831E+00, 0.84979E+00, 0.85127E+00, + & 0.85275E+00, 0.85423E+00, 0.85571E+00, 0.85719E+00, 0.85866E+00, + & 0.86013E+00, 0.86160E+00, 0.86307E+00, 0.86454E+00, 0.86601E+00, + & 0.86747E+00, 0.86893E+00, 0.87039E+00, 0.87185E+00, 0.87331E+00, + & 0.87477E+00, 0.87622E+00, 0.87768E+00, 0.87913E+00, 0.88058E+00, + & 0.88203E+00, 0.88347E+00, 0.88492E+00, 0.88636E+00, 0.88780E+00, + & 0.88924E+00, 0.89068E+00, 0.89212E+00, 0.89356E+00, 0.89499E+00, + & 0.89642E+00, 0.89786E+00, 0.89929E+00, 0.90071E+00, 0.90214E+00, + & 0.90357E+00, 0.90499E+00, 0.90641E+00, 0.90783E+00, 0.90925E+00, + & 0.91067E+00, 0.91209E+00, 0.91350E+00, 0.91491E+00, 0.92020E+00/ + + DATA (BNC09M (I),I=601,700)/ + & 0.93176E+00, 0.94563E+00, 0.95937E+00, 0.97296E+00, 0.98643E+00, + & 0.99976E+00, 0.10130E+01, 0.10260E+01, 0.10390E+01, 0.10518E+01, + & 0.10645E+01, 0.10771E+01, 0.10896E+01, 0.11020E+01, 0.11142E+01, + & 0.11264E+01, 0.11384E+01, 0.11504E+01, 0.11622E+01, 0.11740E+01, + & 0.11856E+01, 0.11972E+01, 0.12086E+01, 0.12200E+01, 0.12313E+01, + & 0.12425E+01, 0.12536E+01, 0.12646E+01, 0.12755E+01, 0.12864E+01, + & 0.12971E+01, 0.13078E+01, 0.13184E+01, 0.13290E+01, 0.13394E+01, + & 0.13498E+01, 0.13601E+01, 0.13704E+01, 0.13805E+01, 0.13906E+01, + & 0.14006E+01, 0.14106E+01, 0.14205E+01, 0.14303E+01, 0.14401E+01, + & 0.14498E+01, 0.14594E+01, 0.14690E+01, 0.14785E+01, 0.14880E+01, + & 0.14974E+01, 0.15067E+01, 0.15160E+01, 0.15252E+01, 0.15344E+01, + & 0.15435E+01, 0.15526E+01, 0.15616E+01, 0.15706E+01, 0.15795E+01, + & 0.15883E+01, 0.15971E+01, 0.16059E+01, 0.16146E+01, 0.16233E+01, + & 0.16319E+01, 0.16404E+01, 0.16489E+01, 0.16574E+01, 0.16658E+01, + & 0.16742E+01, 0.16825E+01, 0.16908E+01, 0.16991E+01, 0.17073E+01, + & 0.17155E+01, 0.17236E+01, 0.17317E+01, 0.17397E+01, 0.17477E+01, + & 0.17557E+01, 0.17636E+01, 0.17715E+01, 0.17793E+01, 0.17871E+01, + & 0.17949E+01, 0.18026E+01, 0.18103E+01, 0.18180E+01, 0.18256E+01, + & 0.18332E+01, 0.18408E+01, 0.18483E+01, 0.18558E+01, 0.18632E+01, + & 0.18707E+01, 0.18780E+01, 0.18854E+01, 0.18927E+01, 0.19000E+01/ + + DATA (BNC09M(I),I=701,741)/ + & 0.19073E+01, 0.19145E+01, 0.19217E+01, 0.19289E+01, 0.19360E+01, + & 0.19431E+01, 0.19502E+01, 0.19572E+01, 0.19643E+01, 0.19713E+01, + & 0.19782E+01, 0.19852E+01, 0.19921E+01, 0.19989E+01, 0.20058E+01, + & 0.20126E+01, 0.20194E+01, 0.20262E+01, 0.20329E+01, 0.20397E+01, + & 0.20464E+01, 0.20530E+01, 0.20597E+01, 0.20663E+01, 0.20729E+01, + & 0.20794E+01, 0.20860E+01, 0.20925E+01, 0.20990E+01, 0.21055E+01, + & 0.21119E+01, 0.21184E+01, 0.21248E+01, 0.21311E+01, 0.21375E+01, + & 0.21438E+01, 0.21502E+01, 0.21564E+01, 0.21627E+01, 0.21690E+01, + & 0.21752E+01 + & / +C +C *** (H, NO3) +C + DATA (BNC10M (I),I= 1,100)/ + &-0.48649E-01,-0.85767E-01,-0.10978E+00,-0.12480E+00,-0.13548E+00, + &-0.14354E+00,-0.14981E+00,-0.15480E+00,-0.15882E+00,-0.16206E+00, + &-0.16468E+00,-0.16679E+00,-0.16847E+00,-0.16978E+00,-0.17078E+00, + &-0.17151E+00,-0.17200E+00,-0.17228E+00,-0.17237E+00,-0.17230E+00, + &-0.17208E+00,-0.17173E+00,-0.17125E+00,-0.17067E+00,-0.16998E+00, + &-0.16921E+00,-0.16835E+00,-0.16742E+00,-0.16643E+00,-0.16536E+00, + &-0.16425E+00,-0.16308E+00,-0.16186E+00,-0.16060E+00,-0.15929E+00, + &-0.15795E+00,-0.15658E+00,-0.15518E+00,-0.15375E+00,-0.15229E+00, + &-0.15080E+00,-0.14930E+00,-0.14778E+00,-0.14623E+00,-0.14468E+00, + &-0.14310E+00,-0.14151E+00,-0.13991E+00,-0.13830E+00,-0.13667E+00, + &-0.13504E+00,-0.13339E+00,-0.13174E+00,-0.13008E+00,-0.12841E+00, + &-0.12673E+00,-0.12505E+00,-0.12335E+00,-0.12166E+00,-0.11995E+00, + &-0.11824E+00,-0.11652E+00,-0.11479E+00,-0.11306E+00,-0.11132E+00, + &-0.10957E+00,-0.10782E+00,-0.10605E+00,-0.10428E+00,-0.10250E+00, + &-0.10071E+00,-0.98911E-01,-0.97103E-01,-0.95285E-01,-0.93457E-01, + &-0.91617E-01,-0.89767E-01,-0.87906E-01,-0.86032E-01,-0.84147E-01, + &-0.82250E-01,-0.80340E-01,-0.78418E-01,-0.76482E-01,-0.74534E-01, + &-0.72572E-01,-0.70597E-01,-0.68609E-01,-0.66607E-01,-0.64593E-01, + &-0.62565E-01,-0.60523E-01,-0.58469E-01,-0.56402E-01,-0.54322E-01, + &-0.52230E-01,-0.50125E-01,-0.48009E-01,-0.45881E-01,-0.43741E-01/ + + DATA (BNC10M (I),I=101,200)/ + &-0.41591E-01,-0.39430E-01,-0.37259E-01,-0.35077E-01,-0.32887E-01, + &-0.30687E-01,-0.28479E-01,-0.26263E-01,-0.24039E-01,-0.21808E-01, + &-0.19569E-01,-0.17325E-01,-0.15074E-01,-0.12818E-01,-0.10556E-01, + &-0.82900E-02,-0.60192E-02,-0.37444E-02,-0.14659E-02, 0.81591E-03, + & 0.28768E-02, 0.51902E-02, 0.75034E-02, 0.98163E-02, 0.12129E-01, + & 0.14441E-01, 0.16752E-01, 0.19063E-01, 0.21374E-01, 0.23683E-01, + & 0.25992E-01, 0.28300E-01, 0.30607E-01, 0.32913E-01, 0.35219E-01, + & 0.37523E-01, 0.39826E-01, 0.42127E-01, 0.44428E-01, 0.46727E-01, + & 0.49025E-01, 0.51322E-01, 0.53617E-01, 0.55911E-01, 0.58203E-01, + & 0.60494E-01, 0.62784E-01, 0.65071E-01, 0.67357E-01, 0.69642E-01, + & 0.71924E-01, 0.74205E-01, 0.76484E-01, 0.78761E-01, 0.81037E-01, + & 0.83310E-01, 0.85582E-01, 0.87852E-01, 0.90120E-01, 0.92385E-01, + & 0.94649E-01, 0.96911E-01, 0.99170E-01, 0.10143E+00, 0.10368E+00, + & 0.10594E+00, 0.10819E+00, 0.11044E+00, 0.11268E+00, 0.11493E+00, + & 0.11717E+00, 0.11941E+00, 0.12165E+00, 0.12388E+00, 0.12612E+00, + & 0.12835E+00, 0.13058E+00, 0.13280E+00, 0.13503E+00, 0.13725E+00, + & 0.13947E+00, 0.14168E+00, 0.14390E+00, 0.14611E+00, 0.14832E+00, + & 0.15052E+00, 0.15273E+00, 0.15493E+00, 0.15713E+00, 0.15932E+00, + & 0.16152E+00, 0.16371E+00, 0.16590E+00, 0.16808E+00, 0.17027E+00, + & 0.17245E+00, 0.17463E+00, 0.17680E+00, 0.17898E+00, 0.18115E+00/ + + DATA (BNC10M (I),I=201,300)/ + & 0.18332E+00, 0.18548E+00, 0.18764E+00, 0.18980E+00, 0.19196E+00, + & 0.19412E+00, 0.19627E+00, 0.19842E+00, 0.20056E+00, 0.20271E+00, + & 0.20485E+00, 0.20699E+00, 0.20912E+00, 0.21126E+00, 0.21339E+00, + & 0.21552E+00, 0.21764E+00, 0.21976E+00, 0.22188E+00, 0.22400E+00, + & 0.22611E+00, 0.22823E+00, 0.23033E+00, 0.23244E+00, 0.23454E+00, + & 0.23664E+00, 0.23874E+00, 0.24084E+00, 0.24293E+00, 0.24502E+00, + & 0.24711E+00, 0.24919E+00, 0.25127E+00, 0.25335E+00, 0.25543E+00, + & 0.25750E+00, 0.25957E+00, 0.26164E+00, 0.26370E+00, 0.26577E+00, + & 0.26783E+00, 0.26988E+00, 0.27194E+00, 0.27399E+00, 0.27604E+00, + & 0.27808E+00, 0.28013E+00, 0.28217E+00, 0.28420E+00, 0.28624E+00, + & 0.28827E+00, 0.29030E+00, 0.29233E+00, 0.29435E+00, 0.29637E+00, + & 0.29839E+00, 0.30041E+00, 0.30242E+00, 0.30443E+00, 0.30644E+00, + & 0.30844E+00, 0.31044E+00, 0.31244E+00, 0.31444E+00, 0.31644E+00, + & 0.31843E+00, 0.32042E+00, 0.32240E+00, 0.32439E+00, 0.32637E+00, + & 0.32834E+00, 0.33032E+00, 0.33229E+00, 0.33426E+00, 0.33623E+00, + & 0.33819E+00, 0.34016E+00, 0.34211E+00, 0.34407E+00, 0.34603E+00, + & 0.34798E+00, 0.34993E+00, 0.35187E+00, 0.35382E+00, 0.35576E+00, + & 0.35769E+00, 0.35963E+00, 0.36156E+00, 0.36349E+00, 0.36542E+00, + & 0.36735E+00, 0.36927E+00, 0.37119E+00, 0.37310E+00, 0.37502E+00, + & 0.37693E+00, 0.37884E+00, 0.38075E+00, 0.38265E+00, 0.38455E+00/ + + DATA (BNC10M (I),I=301,400)/ + & 0.38645E+00, 0.38835E+00, 0.39024E+00, 0.39213E+00, 0.39402E+00, + & 0.39591E+00, 0.39779E+00, 0.39968E+00, 0.40155E+00, 0.40343E+00, + & 0.40530E+00, 0.40717E+00, 0.40904E+00, 0.41091E+00, 0.41277E+00, + & 0.41463E+00, 0.41649E+00, 0.41835E+00, 0.42020E+00, 0.42205E+00, + & 0.42390E+00, 0.42575E+00, 0.42759E+00, 0.42943E+00, 0.43127E+00, + & 0.43311E+00, 0.43494E+00, 0.43677E+00, 0.43860E+00, 0.44043E+00, + & 0.44225E+00, 0.44407E+00, 0.44589E+00, 0.44771E+00, 0.44952E+00, + & 0.45134E+00, 0.45315E+00, 0.45495E+00, 0.45676E+00, 0.45856E+00, + & 0.46036E+00, 0.46216E+00, 0.46395E+00, 0.46575E+00, 0.46754E+00, + & 0.46932E+00, 0.47111E+00, 0.47289E+00, 0.47467E+00, 0.47645E+00, + & 0.47823E+00, 0.48000E+00, 0.48178E+00, 0.48355E+00, 0.48531E+00, + & 0.48708E+00, 0.48884E+00, 0.49060E+00, 0.49236E+00, 0.49411E+00, + & 0.49587E+00, 0.49762E+00, 0.49937E+00, 0.50111E+00, 0.50286E+00, + & 0.50460E+00, 0.50634E+00, 0.50808E+00, 0.50981E+00, 0.51154E+00, + & 0.51327E+00, 0.51500E+00, 0.51673E+00, 0.51845E+00, 0.52017E+00, + & 0.52189E+00, 0.52361E+00, 0.52533E+00, 0.52704E+00, 0.52875E+00, + & 0.53046E+00, 0.53216E+00, 0.53387E+00, 0.53557E+00, 0.53727E+00, + & 0.53897E+00, 0.54066E+00, 0.54236E+00, 0.54405E+00, 0.54574E+00, + & 0.54742E+00, 0.54911E+00, 0.55079E+00, 0.55247E+00, 0.55415E+00, + & 0.55583E+00, 0.55750E+00, 0.55917E+00, 0.56084E+00, 0.56251E+00/ + + DATA (BNC10M (I),I=401,500)/ + & 0.56418E+00, 0.56584E+00, 0.56750E+00, 0.56916E+00, 0.57082E+00, + & 0.57247E+00, 0.57413E+00, 0.57578E+00, 0.57743E+00, 0.57907E+00, + & 0.58072E+00, 0.58236E+00, 0.58400E+00, 0.58564E+00, 0.58728E+00, + & 0.58891E+00, 0.59055E+00, 0.59218E+00, 0.59380E+00, 0.59543E+00, + & 0.59706E+00, 0.59868E+00, 0.60030E+00, 0.60192E+00, 0.60354E+00, + & 0.60515E+00, 0.60676E+00, 0.60837E+00, 0.60998E+00, 0.61159E+00, + & 0.61319E+00, 0.61480E+00, 0.61640E+00, 0.61800E+00, 0.61959E+00, + & 0.62119E+00, 0.62278E+00, 0.62437E+00, 0.62596E+00, 0.62755E+00, + & 0.62914E+00, 0.63072E+00, 0.63230E+00, 0.63388E+00, 0.63546E+00, + & 0.63704E+00, 0.63861E+00, 0.64018E+00, 0.64175E+00, 0.64332E+00, + & 0.64489E+00, 0.64645E+00, 0.64802E+00, 0.64958E+00, 0.65114E+00, + & 0.65269E+00, 0.65425E+00, 0.65580E+00, 0.65735E+00, 0.65890E+00, + & 0.66045E+00, 0.66200E+00, 0.66354E+00, 0.66509E+00, 0.66663E+00, + & 0.66817E+00, 0.66970E+00, 0.67124E+00, 0.67277E+00, 0.67431E+00, + & 0.67584E+00, 0.67736E+00, 0.67889E+00, 0.68042E+00, 0.68194E+00, + & 0.68346E+00, 0.68498E+00, 0.68650E+00, 0.68801E+00, 0.68953E+00, + & 0.69104E+00, 0.69255E+00, 0.69406E+00, 0.69557E+00, 0.69707E+00, + & 0.69858E+00, 0.70008E+00, 0.70158E+00, 0.70308E+00, 0.70457E+00, + & 0.70607E+00, 0.70756E+00, 0.70905E+00, 0.71054E+00, 0.71203E+00, + & 0.71352E+00, 0.71500E+00, 0.71649E+00, 0.71797E+00, 0.71945E+00/ + + DATA (BNC10M (I),I=501,600)/ + & 0.72093E+00, 0.72240E+00, 0.72388E+00, 0.72535E+00, 0.72682E+00, + & 0.72829E+00, 0.72976E+00, 0.73123E+00, 0.73269E+00, 0.73416E+00, + & 0.73562E+00, 0.73708E+00, 0.73854E+00, 0.74000E+00, 0.74145E+00, + & 0.74290E+00, 0.74436E+00, 0.74581E+00, 0.74726E+00, 0.74870E+00, + & 0.75015E+00, 0.75159E+00, 0.75304E+00, 0.75448E+00, 0.75592E+00, + & 0.75735E+00, 0.75879E+00, 0.76022E+00, 0.76166E+00, 0.76309E+00, + & 0.76452E+00, 0.76595E+00, 0.76737E+00, 0.76880E+00, 0.77022E+00, + & 0.77164E+00, 0.77307E+00, 0.77448E+00, 0.77590E+00, 0.77732E+00, + & 0.77873E+00, 0.78015E+00, 0.78156E+00, 0.78297E+00, 0.78437E+00, + & 0.78578E+00, 0.78719E+00, 0.78859E+00, 0.78999E+00, 0.79139E+00, + & 0.79279E+00, 0.79419E+00, 0.79559E+00, 0.79698E+00, 0.79838E+00, + & 0.79977E+00, 0.80116E+00, 0.80255E+00, 0.80393E+00, 0.80532E+00, + & 0.80671E+00, 0.80809E+00, 0.80947E+00, 0.81085E+00, 0.81223E+00, + & 0.81361E+00, 0.81498E+00, 0.81636E+00, 0.81773E+00, 0.81910E+00, + & 0.82047E+00, 0.82184E+00, 0.82321E+00, 0.82457E+00, 0.82594E+00, + & 0.82730E+00, 0.82866E+00, 0.83002E+00, 0.83138E+00, 0.83274E+00, + & 0.83409E+00, 0.83545E+00, 0.83680E+00, 0.83815E+00, 0.83950E+00, + & 0.84085E+00, 0.84220E+00, 0.84355E+00, 0.84489E+00, 0.84624E+00, + & 0.84758E+00, 0.84892E+00, 0.85026E+00, 0.85160E+00, 0.85293E+00, + & 0.85427E+00, 0.85560E+00, 0.85693E+00, 0.85827E+00, 0.86325E+00/ + + DATA (BNC10M (I),I=601,700)/ + & 0.87414E+00, 0.88722E+00, 0.90017E+00, 0.91300E+00, 0.92570E+00, + & 0.93828E+00, 0.95075E+00, 0.96310E+00, 0.97533E+00, 0.98746E+00, + & 0.99947E+00, 0.10114E+01, 0.10232E+01, 0.10349E+01, 0.10465E+01, + & 0.10580E+01, 0.10694E+01, 0.10807E+01, 0.10919E+01, 0.11030E+01, + & 0.11141E+01, 0.11250E+01, 0.11358E+01, 0.11466E+01, 0.11573E+01, + & 0.11679E+01, 0.11784E+01, 0.11889E+01, 0.11992E+01, 0.12095E+01, + & 0.12197E+01, 0.12299E+01, 0.12399E+01, 0.12499E+01, 0.12598E+01, + & 0.12697E+01, 0.12795E+01, 0.12892E+01, 0.12988E+01, 0.13084E+01, + & 0.13179E+01, 0.13274E+01, 0.13367E+01, 0.13461E+01, 0.13553E+01, + & 0.13645E+01, 0.13737E+01, 0.13828E+01, 0.13918E+01, 0.14008E+01, + & 0.14097E+01, 0.14186E+01, 0.14274E+01, 0.14362E+01, 0.14449E+01, + & 0.14535E+01, 0.14621E+01, 0.14707E+01, 0.14792E+01, 0.14876E+01, + & 0.14960E+01, 0.15044E+01, 0.15127E+01, 0.15210E+01, 0.15292E+01, + & 0.15374E+01, 0.15455E+01, 0.15536E+01, 0.15616E+01, 0.15696E+01, + & 0.15776E+01, 0.15855E+01, 0.15934E+01, 0.16012E+01, 0.16090E+01, + & 0.16168E+01, 0.16245E+01, 0.16322E+01, 0.16398E+01, 0.16474E+01, + & 0.16550E+01, 0.16625E+01, 0.16700E+01, 0.16774E+01, 0.16849E+01, + & 0.16922E+01, 0.16996E+01, 0.17069E+01, 0.17142E+01, 0.17214E+01, + & 0.17286E+01, 0.17358E+01, 0.17430E+01, 0.17501E+01, 0.17572E+01, + & 0.17642E+01, 0.17712E+01, 0.17782E+01, 0.17852E+01, 0.17921E+01/ + + DATA (BNC10M(I),I=701,741)/ + & 0.17990E+01, 0.18059E+01, 0.18127E+01, 0.18195E+01, 0.18263E+01, + & 0.18331E+01, 0.18398E+01, 0.18465E+01, 0.18532E+01, 0.18598E+01, + & 0.18664E+01, 0.18730E+01, 0.18796E+01, 0.18861E+01, 0.18926E+01, + & 0.18991E+01, 0.19056E+01, 0.19120E+01, 0.19184E+01, 0.19248E+01, + & 0.19312E+01, 0.19375E+01, 0.19439E+01, 0.19502E+01, 0.19564E+01, + & 0.19627E+01, 0.19689E+01, 0.19751E+01, 0.19813E+01, 0.19874E+01, + & 0.19936E+01, 0.19997E+01, 0.20058E+01, 0.20118E+01, 0.20179E+01, + & 0.20239E+01, 0.20299E+01, 0.20359E+01, 0.20419E+01, 0.20478E+01, + & 0.20537E+01 + & / +C +C *** (H, Cl) +C + DATA (BNC11M (I),I= 1,100)/ + &-0.47533E-01,-0.81940E-01,-0.10288E+00,-0.11511E+00,-0.12316E+00, + &-0.12868E+00,-0.13248E+00,-0.13503E+00,-0.13662E+00,-0.13745E+00, + &-0.13766E+00,-0.13734E+00,-0.13659E+00,-0.13546E+00,-0.13399E+00, + &-0.13224E+00,-0.13022E+00,-0.12796E+00,-0.12550E+00,-0.12284E+00, + &-0.12001E+00,-0.11702E+00,-0.11388E+00,-0.11061E+00,-0.10721E+00, + &-0.10369E+00,-0.10007E+00,-0.96344E-01,-0.92526E-01,-0.88621E-01, + &-0.84635E-01,-0.80573E-01,-0.76440E-01,-0.72241E-01,-0.67980E-01, + &-0.63661E-01,-0.59289E-01,-0.54866E-01,-0.50396E-01,-0.45882E-01, + &-0.41327E-01,-0.36734E-01,-0.32105E-01,-0.27442E-01,-0.22748E-01, + &-0.18025E-01,-0.13275E-01,-0.84990E-02,-0.36992E-02, 0.11231E-02, + & 0.59666E-02, 0.10830E-01, 0.15712E-01, 0.20613E-01, 0.25530E-01, + & 0.30464E-01, 0.35414E-01, 0.40380E-01, 0.45360E-01, 0.50356E-01, + & 0.55366E-01, 0.60391E-01, 0.65431E-01, 0.70486E-01, 0.75557E-01, + & 0.80642E-01, 0.85744E-01, 0.90863E-01, 0.95998E-01, 0.10115E+00, + & 0.10632E+00, 0.11151E+00, 0.11672E+00, 0.12195E+00, 0.12720E+00, + & 0.13247E+00, 0.13777E+00, 0.14308E+00, 0.14843E+00, 0.15379E+00, + & 0.15918E+00, 0.16460E+00, 0.17004E+00, 0.17550E+00, 0.18100E+00, + & 0.18652E+00, 0.19207E+00, 0.19764E+00, 0.20324E+00, 0.20887E+00, + & 0.21453E+00, 0.22022E+00, 0.22593E+00, 0.23166E+00, 0.23743E+00, + & 0.24322E+00, 0.24903E+00, 0.25487E+00, 0.26073E+00, 0.26661E+00/ + + DATA (BNC11M (I),I=101,200)/ + & 0.27252E+00, 0.27845E+00, 0.28440E+00, 0.29037E+00, 0.29635E+00, + & 0.30235E+00, 0.30838E+00, 0.31441E+00, 0.32046E+00, 0.32652E+00, + & 0.33260E+00, 0.33869E+00, 0.34478E+00, 0.35089E+00, 0.35701E+00, + & 0.36313E+00, 0.36926E+00, 0.37539E+00, 0.38153E+00, 0.38767E+00, + & 0.39330E+00, 0.39951E+00, 0.40571E+00, 0.41191E+00, 0.41810E+00, + & 0.42429E+00, 0.43047E+00, 0.43665E+00, 0.44282E+00, 0.44898E+00, + & 0.45514E+00, 0.46129E+00, 0.46744E+00, 0.47358E+00, 0.47971E+00, + & 0.48583E+00, 0.49195E+00, 0.49806E+00, 0.50417E+00, 0.51026E+00, + & 0.51635E+00, 0.52243E+00, 0.52850E+00, 0.53456E+00, 0.54062E+00, + & 0.54667E+00, 0.55271E+00, 0.55874E+00, 0.56476E+00, 0.57077E+00, + & 0.57678E+00, 0.58277E+00, 0.58876E+00, 0.59474E+00, 0.60071E+00, + & 0.60667E+00, 0.61262E+00, 0.61856E+00, 0.62449E+00, 0.63041E+00, + & 0.63633E+00, 0.64223E+00, 0.64812E+00, 0.65401E+00, 0.65988E+00, + & 0.66575E+00, 0.67160E+00, 0.67745E+00, 0.68328E+00, 0.68911E+00, + & 0.69493E+00, 0.70073E+00, 0.70653E+00, 0.71231E+00, 0.71809E+00, + & 0.72386E+00, 0.72961E+00, 0.73536E+00, 0.74109E+00, 0.74682E+00, + & 0.75253E+00, 0.75824E+00, 0.76393E+00, 0.76962E+00, 0.77529E+00, + & 0.78096E+00, 0.78661E+00, 0.79226E+00, 0.79789E+00, 0.80351E+00, + & 0.80913E+00, 0.81473E+00, 0.82032E+00, 0.82590E+00, 0.83148E+00, + & 0.83704E+00, 0.84259E+00, 0.84813E+00, 0.85366E+00, 0.85918E+00/ + + DATA (BNC11M (I),I=201,300)/ + & 0.86469E+00, 0.87019E+00, 0.87568E+00, 0.88116E+00, 0.88663E+00, + & 0.89209E+00, 0.89754E+00, 0.90298E+00, 0.90841E+00, 0.91383E+00, + & 0.91923E+00, 0.92463E+00, 0.93002E+00, 0.93540E+00, 0.94077E+00, + & 0.94612E+00, 0.95147E+00, 0.95681E+00, 0.96213E+00, 0.96745E+00, + & 0.97276E+00, 0.97806E+00, 0.98334E+00, 0.98862E+00, 0.99389E+00, + & 0.99914E+00, 0.10044E+01, 0.10096E+01, 0.10149E+01, 0.10201E+01, + & 0.10253E+01, 0.10305E+01, 0.10357E+01, 0.10408E+01, 0.10460E+01, + & 0.10512E+01, 0.10563E+01, 0.10615E+01, 0.10666E+01, 0.10717E+01, + & 0.10768E+01, 0.10819E+01, 0.10870E+01, 0.10921E+01, 0.10972E+01, + & 0.11022E+01, 0.11073E+01, 0.11123E+01, 0.11174E+01, 0.11224E+01, + & 0.11274E+01, 0.11324E+01, 0.11374E+01, 0.11424E+01, 0.11474E+01, + & 0.11523E+01, 0.11573E+01, 0.11622E+01, 0.11672E+01, 0.11721E+01, + & 0.11770E+01, 0.11819E+01, 0.11868E+01, 0.11917E+01, 0.11966E+01, + & 0.12015E+01, 0.12064E+01, 0.12112E+01, 0.12161E+01, 0.12209E+01, + & 0.12258E+01, 0.12306E+01, 0.12354E+01, 0.12402E+01, 0.12450E+01, + & 0.12498E+01, 0.12546E+01, 0.12593E+01, 0.12641E+01, 0.12688E+01, + & 0.12736E+01, 0.12783E+01, 0.12831E+01, 0.12878E+01, 0.12925E+01, + & 0.12972E+01, 0.13019E+01, 0.13066E+01, 0.13112E+01, 0.13159E+01, + & 0.13206E+01, 0.13252E+01, 0.13299E+01, 0.13345E+01, 0.13391E+01, + & 0.13437E+01, 0.13483E+01, 0.13529E+01, 0.13575E+01, 0.13621E+01/ + + DATA (BNC11M (I),I=301,400)/ + & 0.13667E+01, 0.13713E+01, 0.13758E+01, 0.13804E+01, 0.13849E+01, + & 0.13895E+01, 0.13940E+01, 0.13985E+01, 0.14030E+01, 0.14075E+01, + & 0.14120E+01, 0.14165E+01, 0.14210E+01, 0.14255E+01, 0.14299E+01, + & 0.14344E+01, 0.14388E+01, 0.14433E+01, 0.14477E+01, 0.14521E+01, + & 0.14565E+01, 0.14610E+01, 0.14654E+01, 0.14698E+01, 0.14741E+01, + & 0.14785E+01, 0.14829E+01, 0.14873E+01, 0.14916E+01, 0.14960E+01, + & 0.15003E+01, 0.15047E+01, 0.15090E+01, 0.15133E+01, 0.15176E+01, + & 0.15219E+01, 0.15262E+01, 0.15305E+01, 0.15348E+01, 0.15391E+01, + & 0.15433E+01, 0.15476E+01, 0.15519E+01, 0.15561E+01, 0.15604E+01, + & 0.15646E+01, 0.15688E+01, 0.15730E+01, 0.15773E+01, 0.15815E+01, + & 0.15857E+01, 0.15899E+01, 0.15940E+01, 0.15982E+01, 0.16024E+01, + & 0.16066E+01, 0.16107E+01, 0.16149E+01, 0.16190E+01, 0.16231E+01, + & 0.16273E+01, 0.16314E+01, 0.16355E+01, 0.16396E+01, 0.16437E+01, + & 0.16478E+01, 0.16519E+01, 0.16560E+01, 0.16601E+01, 0.16642E+01, + & 0.16682E+01, 0.16723E+01, 0.16763E+01, 0.16804E+01, 0.16844E+01, + & 0.16884E+01, 0.16925E+01, 0.16965E+01, 0.17005E+01, 0.17045E+01, + & 0.17085E+01, 0.17125E+01, 0.17165E+01, 0.17205E+01, 0.17245E+01, + & 0.17284E+01, 0.17324E+01, 0.17363E+01, 0.17403E+01, 0.17442E+01, + & 0.17482E+01, 0.17521E+01, 0.17560E+01, 0.17599E+01, 0.17639E+01, + & 0.17678E+01, 0.17717E+01, 0.17756E+01, 0.17795E+01, 0.17833E+01/ + + DATA (BNC11M (I),I=401,500)/ + & 0.17872E+01, 0.17911E+01, 0.17950E+01, 0.17988E+01, 0.18027E+01, + & 0.18065E+01, 0.18104E+01, 0.18142E+01, 0.18180E+01, 0.18218E+01, + & 0.18257E+01, 0.18295E+01, 0.18333E+01, 0.18371E+01, 0.18409E+01, + & 0.18447E+01, 0.18485E+01, 0.18522E+01, 0.18560E+01, 0.18598E+01, + & 0.18635E+01, 0.18673E+01, 0.18710E+01, 0.18748E+01, 0.18785E+01, + & 0.18823E+01, 0.18860E+01, 0.18897E+01, 0.18934E+01, 0.18971E+01, + & 0.19008E+01, 0.19045E+01, 0.19082E+01, 0.19119E+01, 0.19156E+01, + & 0.19193E+01, 0.19230E+01, 0.19266E+01, 0.19303E+01, 0.19340E+01, + & 0.19376E+01, 0.19413E+01, 0.19449E+01, 0.19485E+01, 0.19522E+01, + & 0.19558E+01, 0.19594E+01, 0.19630E+01, 0.19666E+01, 0.19702E+01, + & 0.19738E+01, 0.19774E+01, 0.19810E+01, 0.19846E+01, 0.19882E+01, + & 0.19918E+01, 0.19953E+01, 0.19989E+01, 0.20025E+01, 0.20060E+01, + & 0.20096E+01, 0.20131E+01, 0.20167E+01, 0.20202E+01, 0.20237E+01, + & 0.20272E+01, 0.20308E+01, 0.20343E+01, 0.20378E+01, 0.20413E+01, + & 0.20448E+01, 0.20483E+01, 0.20518E+01, 0.20553E+01, 0.20587E+01, + & 0.20622E+01, 0.20657E+01, 0.20692E+01, 0.20726E+01, 0.20761E+01, + & 0.20795E+01, 0.20830E+01, 0.20864E+01, 0.20899E+01, 0.20933E+01, + & 0.20967E+01, 0.21001E+01, 0.21036E+01, 0.21070E+01, 0.21104E+01, + & 0.21138E+01, 0.21172E+01, 0.21206E+01, 0.21240E+01, 0.21274E+01, + & 0.21308E+01, 0.21341E+01, 0.21375E+01, 0.21409E+01, 0.21442E+01/ + + DATA (BNC11M (I),I=501,600)/ + & 0.21476E+01, 0.21510E+01, 0.21543E+01, 0.21577E+01, 0.21610E+01, + & 0.21643E+01, 0.21677E+01, 0.21710E+01, 0.21743E+01, 0.21776E+01, + & 0.21810E+01, 0.21843E+01, 0.21876E+01, 0.21909E+01, 0.21942E+01, + & 0.21975E+01, 0.22008E+01, 0.22041E+01, 0.22073E+01, 0.22106E+01, + & 0.22139E+01, 0.22172E+01, 0.22204E+01, 0.22237E+01, 0.22269E+01, + & 0.22302E+01, 0.22334E+01, 0.22367E+01, 0.22399E+01, 0.22432E+01, + & 0.22464E+01, 0.22496E+01, 0.22528E+01, 0.22561E+01, 0.22593E+01, + & 0.22625E+01, 0.22657E+01, 0.22689E+01, 0.22721E+01, 0.22753E+01, + & 0.22785E+01, 0.22817E+01, 0.22849E+01, 0.22880E+01, 0.22912E+01, + & 0.22944E+01, 0.22975E+01, 0.23007E+01, 0.23039E+01, 0.23070E+01, + & 0.23102E+01, 0.23133E+01, 0.23165E+01, 0.23196E+01, 0.23227E+01, + & 0.23259E+01, 0.23290E+01, 0.23321E+01, 0.23352E+01, 0.23384E+01, + & 0.23415E+01, 0.23446E+01, 0.23477E+01, 0.23508E+01, 0.23539E+01, + & 0.23570E+01, 0.23601E+01, 0.23632E+01, 0.23662E+01, 0.23693E+01, + & 0.23724E+01, 0.23755E+01, 0.23785E+01, 0.23816E+01, 0.23847E+01, + & 0.23877E+01, 0.23908E+01, 0.23938E+01, 0.23969E+01, 0.23999E+01, + & 0.24029E+01, 0.24060E+01, 0.24090E+01, 0.24120E+01, 0.24150E+01, + & 0.24181E+01, 0.24211E+01, 0.24241E+01, 0.24271E+01, 0.24301E+01, + & 0.24331E+01, 0.24361E+01, 0.24391E+01, 0.24421E+01, 0.24451E+01, + & 0.24481E+01, 0.24511E+01, 0.24540E+01, 0.24570E+01, 0.24681E+01/ + + DATA (BNC11M (I),I=601,700)/ + & 0.24924E+01, 0.25216E+01, 0.25504E+01, 0.25789E+01, 0.26071E+01, + & 0.26349E+01, 0.26625E+01, 0.26898E+01, 0.27168E+01, 0.27435E+01, + & 0.27699E+01, 0.27961E+01, 0.28220E+01, 0.28477E+01, 0.28731E+01, + & 0.28982E+01, 0.29231E+01, 0.29478E+01, 0.29722E+01, 0.29965E+01, + & 0.30205E+01, 0.30442E+01, 0.30678E+01, 0.30911E+01, 0.31143E+01, + & 0.31372E+01, 0.31599E+01, 0.31825E+01, 0.32048E+01, 0.32270E+01, + & 0.32490E+01, 0.32708E+01, 0.32924E+01, 0.33138E+01, 0.33351E+01, + & 0.33562E+01, 0.33771E+01, 0.33979E+01, 0.34185E+01, 0.34389E+01, + & 0.34592E+01, 0.34794E+01, 0.34993E+01, 0.35192E+01, 0.35389E+01, + & 0.35584E+01, 0.35778E+01, 0.35971E+01, 0.36162E+01, 0.36352E+01, + & 0.36541E+01, 0.36728E+01, 0.36914E+01, 0.37099E+01, 0.37282E+01, + & 0.37465E+01, 0.37646E+01, 0.37826E+01, 0.38004E+01, 0.38182E+01, + & 0.38358E+01, 0.38533E+01, 0.38707E+01, 0.38880E+01, 0.39052E+01, + & 0.39223E+01, 0.39393E+01, 0.39562E+01, 0.39729E+01, 0.39896E+01, + & 0.40062E+01, 0.40226E+01, 0.40390E+01, 0.40553E+01, 0.40715E+01, + & 0.40876E+01, 0.41035E+01, 0.41194E+01, 0.41353E+01, 0.41510E+01, + & 0.41666E+01, 0.41822E+01, 0.41976E+01, 0.42130E+01, 0.42283E+01, + & 0.42435E+01, 0.42586E+01, 0.42737E+01, 0.42886E+01, 0.43035E+01, + & 0.43183E+01, 0.43330E+01, 0.43477E+01, 0.43623E+01, 0.43768E+01, + & 0.43912E+01, 0.44056E+01, 0.44198E+01, 0.44341E+01, 0.44482E+01/ + + DATA (BNC11M(I),I=701,741)/ + & 0.44623E+01, 0.44763E+01, 0.44902E+01, 0.45041E+01, 0.45179E+01, + & 0.45316E+01, 0.45453E+01, 0.45589E+01, 0.45724E+01, 0.45859E+01, + & 0.45993E+01, 0.46126E+01, 0.46259E+01, 0.46391E+01, 0.46523E+01, + & 0.46654E+01, 0.46785E+01, 0.46915E+01, 0.47044E+01, 0.47173E+01, + & 0.47301E+01, 0.47428E+01, 0.47555E+01, 0.47682E+01, 0.47808E+01, + & 0.47933E+01, 0.48058E+01, 0.48183E+01, 0.48306E+01, 0.48430E+01, + & 0.48552E+01, 0.48675E+01, 0.48797E+01, 0.48918E+01, 0.49039E+01, + & 0.49159E+01, 0.49279E+01, 0.49398E+01, 0.49517E+01, 0.49635E+01, + & 0.49753E+01 + & / +C +C *** NaHSO4 +C + DATA (BNC12M (I),I= 1,100)/ + &-0.48506E-01,-0.85523E-01,-0.10966E+00,-0.12495E+00,-0.13595E+00, + &-0.14436E+00,-0.15100E+00,-0.15637E+00,-0.16075E+00,-0.16435E+00, + &-0.16731E+00,-0.16974E+00,-0.17171E+00,-0.17329E+00,-0.17453E+00, + &-0.17547E+00,-0.17613E+00,-0.17655E+00,-0.17675E+00,-0.17675E+00, + &-0.17656E+00,-0.17620E+00,-0.17567E+00,-0.17500E+00,-0.17419E+00, + &-0.17325E+00,-0.17219E+00,-0.17101E+00,-0.16973E+00,-0.16834E+00, + &-0.16685E+00,-0.16526E+00,-0.16359E+00,-0.16184E+00,-0.16000E+00, + &-0.15809E+00,-0.15610E+00,-0.15405E+00,-0.15192E+00,-0.14973E+00, + &-0.14749E+00,-0.14518E+00,-0.14281E+00,-0.14040E+00,-0.13793E+00, + &-0.13541E+00,-0.13284E+00,-0.13023E+00,-0.12757E+00,-0.12488E+00, + &-0.12214E+00,-0.11936E+00,-0.11654E+00,-0.11369E+00,-0.11081E+00, + &-0.10789E+00,-0.10493E+00,-0.10195E+00,-0.98933E-01,-0.95887E-01, + &-0.92812E-01,-0.89708E-01,-0.86577E-01,-0.83417E-01,-0.80231E-01, + &-0.77018E-01,-0.73779E-01,-0.70513E-01,-0.67222E-01,-0.63906E-01, + &-0.60563E-01,-0.57196E-01,-0.53803E-01,-0.50385E-01,-0.46941E-01, + &-0.43472E-01,-0.39979E-01,-0.36459E-01,-0.32915E-01,-0.29345E-01, + &-0.25749E-01,-0.22128E-01,-0.18482E-01,-0.14811E-01,-0.11115E-01, + &-0.73934E-02,-0.36468E-02, 0.12404E-03, 0.39196E-02, 0.77393E-02, + & 0.11583E-01, 0.15450E-01, 0.19340E-01, 0.23253E-01, 0.27187E-01, + & 0.31143E-01, 0.35121E-01, 0.39118E-01, 0.43135E-01, 0.47171E-01/ + + DATA (BNC12M (I),I=101,200)/ + & 0.51225E-01, 0.55297E-01, 0.59385E-01, 0.63489E-01, 0.67608E-01, + & 0.71741E-01, 0.75888E-01, 0.80047E-01, 0.84217E-01, 0.88399E-01, + & 0.92590E-01, 0.96791E-01, 0.10100E+00, 0.10522E+00, 0.10944E+00, + & 0.11367E+00, 0.11790E+00, 0.12214E+00, 0.12638E+00, 0.13063E+00, + & 0.13451E+00, 0.13880E+00, 0.14309E+00, 0.14737E+00, 0.15166E+00, + & 0.15593E+00, 0.16021E+00, 0.16448E+00, 0.16874E+00, 0.17301E+00, + & 0.17726E+00, 0.18151E+00, 0.18576E+00, 0.19000E+00, 0.19424E+00, + & 0.19847E+00, 0.20270E+00, 0.20692E+00, 0.21114E+00, 0.21535E+00, + & 0.21955E+00, 0.22375E+00, 0.22794E+00, 0.23213E+00, 0.23630E+00, + & 0.24048E+00, 0.24464E+00, 0.24881E+00, 0.25296E+00, 0.25711E+00, + & 0.26125E+00, 0.26538E+00, 0.26951E+00, 0.27363E+00, 0.27774E+00, + & 0.28185E+00, 0.28595E+00, 0.29004E+00, 0.29413E+00, 0.29821E+00, + & 0.30228E+00, 0.30634E+00, 0.31040E+00, 0.31445E+00, 0.31849E+00, + & 0.32253E+00, 0.32656E+00, 0.33058E+00, 0.33459E+00, 0.33860E+00, + & 0.34260E+00, 0.34659E+00, 0.35057E+00, 0.35455E+00, 0.35852E+00, + & 0.36248E+00, 0.36644E+00, 0.37038E+00, 0.37432E+00, 0.37826E+00, + & 0.38218E+00, 0.38610E+00, 0.39001E+00, 0.39391E+00, 0.39781E+00, + & 0.40170E+00, 0.40558E+00, 0.40945E+00, 0.41332E+00, 0.41718E+00, + & 0.42103E+00, 0.42487E+00, 0.42871E+00, 0.43254E+00, 0.43636E+00, + & 0.44018E+00, 0.44398E+00, 0.44778E+00, 0.45158E+00, 0.45536E+00/ + + DATA (BNC12M (I),I=201,300)/ + & 0.45914E+00, 0.46291E+00, 0.46668E+00, 0.47043E+00, 0.47418E+00, + & 0.47793E+00, 0.48166E+00, 0.48539E+00, 0.48911E+00, 0.49283E+00, + & 0.49653E+00, 0.50023E+00, 0.50393E+00, 0.50761E+00, 0.51129E+00, + & 0.51496E+00, 0.51863E+00, 0.52228E+00, 0.52594E+00, 0.52958E+00, + & 0.53322E+00, 0.53685E+00, 0.54047E+00, 0.54409E+00, 0.54770E+00, + & 0.55130E+00, 0.55490E+00, 0.55849E+00, 0.56207E+00, 0.56564E+00, + & 0.56921E+00, 0.57278E+00, 0.57633E+00, 0.57988E+00, 0.58342E+00, + & 0.58696E+00, 0.59049E+00, 0.59401E+00, 0.59753E+00, 0.60104E+00, + & 0.60454E+00, 0.60804E+00, 0.61153E+00, 0.61501E+00, 0.61849E+00, + & 0.62196E+00, 0.62543E+00, 0.62888E+00, 0.63234E+00, 0.63578E+00, + & 0.63922E+00, 0.64265E+00, 0.64608E+00, 0.64950E+00, 0.65292E+00, + & 0.65632E+00, 0.65973E+00, 0.66312E+00, 0.66651E+00, 0.66990E+00, + & 0.67327E+00, 0.67664E+00, 0.68001E+00, 0.68337E+00, 0.68672E+00, + & 0.69007E+00, 0.69341E+00, 0.69675E+00, 0.70008E+00, 0.70340E+00, + & 0.70672E+00, 0.71003E+00, 0.71334E+00, 0.71664E+00, 0.71993E+00, + & 0.72322E+00, 0.72650E+00, 0.72978E+00, 0.73305E+00, 0.73632E+00, + & 0.73958E+00, 0.74283E+00, 0.74608E+00, 0.74932E+00, 0.75256E+00, + & 0.75579E+00, 0.75902E+00, 0.76224E+00, 0.76546E+00, 0.76867E+00, + & 0.77187E+00, 0.77507E+00, 0.77826E+00, 0.78145E+00, 0.78463E+00, + & 0.78781E+00, 0.79098E+00, 0.79415E+00, 0.79731E+00, 0.80046E+00/ + + DATA (BNC12M (I),I=301,400)/ + & 0.80361E+00, 0.80676E+00, 0.80990E+00, 0.81303E+00, 0.81616E+00, + & 0.81928E+00, 0.82240E+00, 0.82552E+00, 0.82862E+00, 0.83173E+00, + & 0.83483E+00, 0.83792E+00, 0.84101E+00, 0.84409E+00, 0.84717E+00, + & 0.85024E+00, 0.85331E+00, 0.85637E+00, 0.85943E+00, 0.86248E+00, + & 0.86553E+00, 0.86857E+00, 0.87160E+00, 0.87464E+00, 0.87766E+00, + & 0.88069E+00, 0.88371E+00, 0.88672E+00, 0.88973E+00, 0.89273E+00, + & 0.89573E+00, 0.89872E+00, 0.90171E+00, 0.90469E+00, 0.90767E+00, + & 0.91065E+00, 0.91362E+00, 0.91658E+00, 0.91954E+00, 0.92250E+00, + & 0.92545E+00, 0.92840E+00, 0.93134E+00, 0.93427E+00, 0.93721E+00, + & 0.94014E+00, 0.94306E+00, 0.94598E+00, 0.94889E+00, 0.95180E+00, + & 0.95471E+00, 0.95761E+00, 0.96050E+00, 0.96339E+00, 0.96628E+00, + & 0.96916E+00, 0.97204E+00, 0.97492E+00, 0.97779E+00, 0.98065E+00, + & 0.98351E+00, 0.98637E+00, 0.98922E+00, 0.99207E+00, 0.99491E+00, + & 0.99775E+00, 0.10006E+01, 0.10034E+01, 0.10062E+01, 0.10091E+01, + & 0.10119E+01, 0.10147E+01, 0.10175E+01, 0.10203E+01, 0.10231E+01, + & 0.10259E+01, 0.10287E+01, 0.10315E+01, 0.10343E+01, 0.10370E+01, + & 0.10398E+01, 0.10426E+01, 0.10454E+01, 0.10481E+01, 0.10509E+01, + & 0.10536E+01, 0.10564E+01, 0.10591E+01, 0.10619E+01, 0.10646E+01, + & 0.10674E+01, 0.10701E+01, 0.10728E+01, 0.10755E+01, 0.10783E+01, + & 0.10810E+01, 0.10837E+01, 0.10864E+01, 0.10891E+01, 0.10918E+01/ + + DATA (BNC12M (I),I=401,500)/ + & 0.10945E+01, 0.10972E+01, 0.10999E+01, 0.11026E+01, 0.11052E+01, + & 0.11079E+01, 0.11106E+01, 0.11133E+01, 0.11159E+01, 0.11186E+01, + & 0.11212E+01, 0.11239E+01, 0.11265E+01, 0.11292E+01, 0.11318E+01, + & 0.11345E+01, 0.11371E+01, 0.11397E+01, 0.11424E+01, 0.11450E+01, + & 0.11476E+01, 0.11502E+01, 0.11528E+01, 0.11554E+01, 0.11581E+01, + & 0.11607E+01, 0.11633E+01, 0.11658E+01, 0.11684E+01, 0.11710E+01, + & 0.11736E+01, 0.11762E+01, 0.11788E+01, 0.11813E+01, 0.11839E+01, + & 0.11865E+01, 0.11890E+01, 0.11916E+01, 0.11942E+01, 0.11967E+01, + & 0.11993E+01, 0.12018E+01, 0.12044E+01, 0.12069E+01, 0.12094E+01, + & 0.12120E+01, 0.12145E+01, 0.12170E+01, 0.12195E+01, 0.12221E+01, + & 0.12246E+01, 0.12271E+01, 0.12296E+01, 0.12321E+01, 0.12346E+01, + & 0.12371E+01, 0.12396E+01, 0.12421E+01, 0.12446E+01, 0.12471E+01, + & 0.12495E+01, 0.12520E+01, 0.12545E+01, 0.12570E+01, 0.12594E+01, + & 0.12619E+01, 0.12644E+01, 0.12668E+01, 0.12693E+01, 0.12717E+01, + & 0.12742E+01, 0.12766E+01, 0.12791E+01, 0.12815E+01, 0.12839E+01, + & 0.12864E+01, 0.12888E+01, 0.12912E+01, 0.12937E+01, 0.12961E+01, + & 0.12985E+01, 0.13009E+01, 0.13033E+01, 0.13057E+01, 0.13081E+01, + & 0.13106E+01, 0.13130E+01, 0.13153E+01, 0.13177E+01, 0.13201E+01, + & 0.13225E+01, 0.13249E+01, 0.13273E+01, 0.13297E+01, 0.13320E+01, + & 0.13344E+01, 0.13368E+01, 0.13392E+01, 0.13415E+01, 0.13439E+01/ + + DATA (BNC12M (I),I=501,600)/ + & 0.13462E+01, 0.13486E+01, 0.13509E+01, 0.13533E+01, 0.13556E+01, + & 0.13580E+01, 0.13603E+01, 0.13627E+01, 0.13650E+01, 0.13673E+01, + & 0.13697E+01, 0.13720E+01, 0.13743E+01, 0.13766E+01, 0.13789E+01, + & 0.13813E+01, 0.13836E+01, 0.13859E+01, 0.13882E+01, 0.13905E+01, + & 0.13928E+01, 0.13951E+01, 0.13974E+01, 0.13997E+01, 0.14020E+01, + & 0.14042E+01, 0.14065E+01, 0.14088E+01, 0.14111E+01, 0.14134E+01, + & 0.14156E+01, 0.14179E+01, 0.14202E+01, 0.14224E+01, 0.14247E+01, + & 0.14270E+01, 0.14292E+01, 0.14315E+01, 0.14337E+01, 0.14360E+01, + & 0.14382E+01, 0.14405E+01, 0.14427E+01, 0.14449E+01, 0.14472E+01, + & 0.14494E+01, 0.14516E+01, 0.14539E+01, 0.14561E+01, 0.14583E+01, + & 0.14605E+01, 0.14628E+01, 0.14650E+01, 0.14672E+01, 0.14694E+01, + & 0.14716E+01, 0.14738E+01, 0.14760E+01, 0.14782E+01, 0.14804E+01, + & 0.14826E+01, 0.14848E+01, 0.14870E+01, 0.14892E+01, 0.14913E+01, + & 0.14935E+01, 0.14957E+01, 0.14979E+01, 0.15001E+01, 0.15022E+01, + & 0.15044E+01, 0.15066E+01, 0.15087E+01, 0.15109E+01, 0.15130E+01, + & 0.15152E+01, 0.15174E+01, 0.15195E+01, 0.15217E+01, 0.15238E+01, + & 0.15260E+01, 0.15281E+01, 0.15302E+01, 0.15324E+01, 0.15345E+01, + & 0.15366E+01, 0.15388E+01, 0.15409E+01, 0.15430E+01, 0.15451E+01, + & 0.15473E+01, 0.15494E+01, 0.15515E+01, 0.15536E+01, 0.15557E+01, + & 0.15578E+01, 0.15599E+01, 0.15621E+01, 0.15642E+01, 0.15720E+01/ + + DATA (BNC12M (I),I=601,700)/ + & 0.15892E+01, 0.16098E+01, 0.16302E+01, 0.16504E+01, 0.16704E+01, + & 0.16902E+01, 0.17098E+01, 0.17291E+01, 0.17483E+01, 0.17673E+01, + & 0.17861E+01, 0.18047E+01, 0.18232E+01, 0.18415E+01, 0.18596E+01, + & 0.18775E+01, 0.18953E+01, 0.19129E+01, 0.19304E+01, 0.19477E+01, + & 0.19648E+01, 0.19818E+01, 0.19987E+01, 0.20154E+01, 0.20320E+01, + & 0.20484E+01, 0.20647E+01, 0.20809E+01, 0.20969E+01, 0.21128E+01, + & 0.21286E+01, 0.21443E+01, 0.21598E+01, 0.21752E+01, 0.21905E+01, + & 0.22057E+01, 0.22208E+01, 0.22357E+01, 0.22506E+01, 0.22653E+01, + & 0.22800E+01, 0.22945E+01, 0.23089E+01, 0.23232E+01, 0.23374E+01, + & 0.23515E+01, 0.23656E+01, 0.23795E+01, 0.23933E+01, 0.24071E+01, + & 0.24207E+01, 0.24343E+01, 0.24477E+01, 0.24611E+01, 0.24744E+01, + & 0.24876E+01, 0.25007E+01, 0.25138E+01, 0.25267E+01, 0.25396E+01, + & 0.25524E+01, 0.25651E+01, 0.25778E+01, 0.25903E+01, 0.26028E+01, + & 0.26152E+01, 0.26276E+01, 0.26398E+01, 0.26520E+01, 0.26642E+01, + & 0.26762E+01, 0.26882E+01, 0.27001E+01, 0.27120E+01, 0.27238E+01, + & 0.27355E+01, 0.27472E+01, 0.27588E+01, 0.27703E+01, 0.27818E+01, + & 0.27932E+01, 0.28045E+01, 0.28158E+01, 0.28270E+01, 0.28382E+01, + & 0.28493E+01, 0.28604E+01, 0.28714E+01, 0.28823E+01, 0.28932E+01, + & 0.29040E+01, 0.29148E+01, 0.29256E+01, 0.29362E+01, 0.29468E+01, + & 0.29574E+01, 0.29679E+01, 0.29784E+01, 0.29888E+01, 0.29992E+01/ + + DATA (BNC12M(I),I=701,741)/ + & 0.30095E+01, 0.30198E+01, 0.30300E+01, 0.30402E+01, 0.30503E+01, + & 0.30604E+01, 0.30705E+01, 0.30804E+01, 0.30904E+01, 0.31003E+01, + & 0.31102E+01, 0.31200E+01, 0.31298E+01, 0.31395E+01, 0.31492E+01, + & 0.31588E+01, 0.31684E+01, 0.31780E+01, 0.31875E+01, 0.31970E+01, + & 0.32065E+01, 0.32159E+01, 0.32252E+01, 0.32346E+01, 0.32439E+01, + & 0.32531E+01, 0.32623E+01, 0.32715E+01, 0.32807E+01, 0.32898E+01, + & 0.32988E+01, 0.33079E+01, 0.33169E+01, 0.33258E+01, 0.33348E+01, + & 0.33436E+01, 0.33525E+01, 0.33613E+01, 0.33701E+01, 0.33789E+01, + & 0.33876E+01 + & / +C +C *** (NH4)3H(SO4)2 +C + DATA (BNC13M (I),I= 1,100)/ + &-0.79876E-01,-0.14479E+00,-0.19002E+00,-0.22052E+00,-0.24382E+00, + &-0.26276E+00,-0.27871E+00,-0.29249E+00,-0.30460E+00,-0.31540E+00, + &-0.32512E+00,-0.33395E+00,-0.34203E+00,-0.34946E+00,-0.35632E+00, + &-0.36270E+00,-0.36864E+00,-0.37419E+00,-0.37939E+00,-0.38427E+00, + &-0.38886E+00,-0.39320E+00,-0.39728E+00,-0.40115E+00,-0.40481E+00, + &-0.40828E+00,-0.41157E+00,-0.41469E+00,-0.41766E+00,-0.42048E+00, + &-0.42316E+00,-0.42571E+00,-0.42814E+00,-0.43045E+00,-0.43265E+00, + &-0.43474E+00,-0.43673E+00,-0.43863E+00,-0.44044E+00,-0.44216E+00, + &-0.44379E+00,-0.44535E+00,-0.44683E+00,-0.44824E+00,-0.44958E+00, + &-0.45085E+00,-0.45205E+00,-0.45320E+00,-0.45428E+00,-0.45531E+00, + &-0.45628E+00,-0.45720E+00,-0.45807E+00,-0.45888E+00,-0.45966E+00, + &-0.46038E+00,-0.46106E+00,-0.46170E+00,-0.46230E+00,-0.46285E+00, + &-0.46337E+00,-0.46385E+00,-0.46430E+00,-0.46471E+00,-0.46508E+00, + &-0.46542E+00,-0.46574E+00,-0.46602E+00,-0.46627E+00,-0.46649E+00, + &-0.46668E+00,-0.46684E+00,-0.46698E+00,-0.46710E+00,-0.46718E+00, + &-0.46724E+00,-0.46728E+00,-0.46730E+00,-0.46729E+00,-0.46726E+00, + &-0.46720E+00,-0.46713E+00,-0.46703E+00,-0.46691E+00,-0.46678E+00, + &-0.46662E+00,-0.46644E+00,-0.46625E+00,-0.46604E+00,-0.46580E+00, + &-0.46556E+00,-0.46529E+00,-0.46501E+00,-0.46471E+00,-0.46439E+00, + &-0.46406E+00,-0.46372E+00,-0.46335E+00,-0.46298E+00,-0.46259E+00/ + + DATA (BNC13M (I),I=101,200)/ + &-0.46219E+00,-0.46177E+00,-0.46134E+00,-0.46090E+00,-0.46045E+00, + &-0.45998E+00,-0.45951E+00,-0.45902E+00,-0.45852E+00,-0.45801E+00, + &-0.45749E+00,-0.45697E+00,-0.45643E+00,-0.45588E+00,-0.45533E+00, + &-0.45477E+00,-0.45420E+00,-0.45362E+00,-0.45303E+00,-0.45244E+00, + &-0.45191E+00,-0.45130E+00,-0.45068E+00,-0.45006E+00,-0.44943E+00, + &-0.44879E+00,-0.44815E+00,-0.44751E+00,-0.44686E+00,-0.44621E+00, + &-0.44555E+00,-0.44489E+00,-0.44423E+00,-0.44356E+00,-0.44289E+00, + &-0.44221E+00,-0.44154E+00,-0.44085E+00,-0.44017E+00,-0.43948E+00, + &-0.43879E+00,-0.43810E+00,-0.43740E+00,-0.43670E+00,-0.43600E+00, + &-0.43530E+00,-0.43459E+00,-0.43388E+00,-0.43317E+00,-0.43246E+00, + &-0.43174E+00,-0.43103E+00,-0.43031E+00,-0.42959E+00,-0.42886E+00, + &-0.42814E+00,-0.42741E+00,-0.42669E+00,-0.42596E+00,-0.42523E+00, + &-0.42449E+00,-0.42376E+00,-0.42302E+00,-0.42229E+00,-0.42155E+00, + &-0.42081E+00,-0.42007E+00,-0.41933E+00,-0.41859E+00,-0.41785E+00, + &-0.41711E+00,-0.41636E+00,-0.41562E+00,-0.41487E+00,-0.41412E+00, + &-0.41337E+00,-0.41263E+00,-0.41188E+00,-0.41113E+00,-0.41038E+00, + &-0.40962E+00,-0.40887E+00,-0.40812E+00,-0.40737E+00,-0.40661E+00, + &-0.40586E+00,-0.40511E+00,-0.40435E+00,-0.40360E+00,-0.40284E+00, + &-0.40209E+00,-0.40133E+00,-0.40057E+00,-0.39982E+00,-0.39906E+00, + &-0.39830E+00,-0.39755E+00,-0.39679E+00,-0.39603E+00,-0.39527E+00/ + + DATA (BNC13M (I),I=201,300)/ + &-0.39452E+00,-0.39376E+00,-0.39300E+00,-0.39224E+00,-0.39148E+00, + &-0.39072E+00,-0.38997E+00,-0.38921E+00,-0.38845E+00,-0.38769E+00, + &-0.38693E+00,-0.38617E+00,-0.38542E+00,-0.38466E+00,-0.38390E+00, + &-0.38314E+00,-0.38238E+00,-0.38162E+00,-0.38087E+00,-0.38011E+00, + &-0.37935E+00,-0.37859E+00,-0.37784E+00,-0.37708E+00,-0.37632E+00, + &-0.37556E+00,-0.37481E+00,-0.37405E+00,-0.37329E+00,-0.37254E+00, + &-0.37178E+00,-0.37103E+00,-0.37027E+00,-0.36952E+00,-0.36876E+00, + &-0.36801E+00,-0.36725E+00,-0.36650E+00,-0.36574E+00,-0.36499E+00, + &-0.36423E+00,-0.36348E+00,-0.36273E+00,-0.36198E+00,-0.36122E+00, + &-0.36047E+00,-0.35972E+00,-0.35897E+00,-0.35822E+00,-0.35747E+00, + &-0.35672E+00,-0.35597E+00,-0.35522E+00,-0.35447E+00,-0.35372E+00, + &-0.35297E+00,-0.35222E+00,-0.35147E+00,-0.35072E+00,-0.34998E+00, + &-0.34923E+00,-0.34848E+00,-0.34774E+00,-0.34699E+00,-0.34624E+00, + &-0.34550E+00,-0.34475E+00,-0.34401E+00,-0.34327E+00,-0.34252E+00, + &-0.34178E+00,-0.34104E+00,-0.34029E+00,-0.33955E+00,-0.33881E+00, + &-0.33807E+00,-0.33733E+00,-0.33659E+00,-0.33585E+00,-0.33511E+00, + &-0.33437E+00,-0.33363E+00,-0.33289E+00,-0.33216E+00,-0.33142E+00, + &-0.33068E+00,-0.32994E+00,-0.32921E+00,-0.32847E+00,-0.32774E+00, + &-0.32700E+00,-0.32627E+00,-0.32553E+00,-0.32480E+00,-0.32407E+00, + &-0.32334E+00,-0.32260E+00,-0.32187E+00,-0.32114E+00,-0.32041E+00/ + + DATA (BNC13M (I),I=301,400)/ + &-0.31968E+00,-0.31895E+00,-0.31822E+00,-0.31749E+00,-0.31676E+00, + &-0.31603E+00,-0.31531E+00,-0.31458E+00,-0.31385E+00,-0.31313E+00, + &-0.31240E+00,-0.31167E+00,-0.31095E+00,-0.31023E+00,-0.30950E+00, + &-0.30878E+00,-0.30805E+00,-0.30733E+00,-0.30661E+00,-0.30589E+00, + &-0.30517E+00,-0.30445E+00,-0.30373E+00,-0.30301E+00,-0.30229E+00, + &-0.30157E+00,-0.30085E+00,-0.30013E+00,-0.29941E+00,-0.29870E+00, + &-0.29798E+00,-0.29726E+00,-0.29655E+00,-0.29583E+00,-0.29512E+00, + &-0.29440E+00,-0.29369E+00,-0.29298E+00,-0.29226E+00,-0.29155E+00, + &-0.29084E+00,-0.29013E+00,-0.28942E+00,-0.28871E+00,-0.28800E+00, + &-0.28729E+00,-0.28658E+00,-0.28587E+00,-0.28516E+00,-0.28445E+00, + &-0.28375E+00,-0.28304E+00,-0.28233E+00,-0.28163E+00,-0.28092E+00, + &-0.28022E+00,-0.27951E+00,-0.27881E+00,-0.27811E+00,-0.27740E+00, + &-0.27670E+00,-0.27600E+00,-0.27530E+00,-0.27459E+00,-0.27389E+00, + &-0.27319E+00,-0.27249E+00,-0.27179E+00,-0.27110E+00,-0.27040E+00, + &-0.26970E+00,-0.26900E+00,-0.26831E+00,-0.26761E+00,-0.26691E+00, + &-0.26622E+00,-0.26552E+00,-0.26483E+00,-0.26413E+00,-0.26344E+00, + &-0.26275E+00,-0.26205E+00,-0.26136E+00,-0.26067E+00,-0.25998E+00, + &-0.25929E+00,-0.25860E+00,-0.25791E+00,-0.25722E+00,-0.25653E+00, + &-0.25584E+00,-0.25515E+00,-0.25446E+00,-0.25378E+00,-0.25309E+00, + &-0.25240E+00,-0.25172E+00,-0.25103E+00,-0.25035E+00,-0.24966E+00/ + + DATA (BNC13M (I),I=401,500)/ + &-0.24898E+00,-0.24829E+00,-0.24761E+00,-0.24693E+00,-0.24625E+00, + &-0.24556E+00,-0.24488E+00,-0.24420E+00,-0.24352E+00,-0.24284E+00, + &-0.24216E+00,-0.24148E+00,-0.24080E+00,-0.24013E+00,-0.23945E+00, + &-0.23877E+00,-0.23809E+00,-0.23742E+00,-0.23674E+00,-0.23607E+00, + &-0.23539E+00,-0.23472E+00,-0.23404E+00,-0.23337E+00,-0.23270E+00, + &-0.23202E+00,-0.23135E+00,-0.23068E+00,-0.23001E+00,-0.22934E+00, + &-0.22867E+00,-0.22800E+00,-0.22733E+00,-0.22666E+00,-0.22599E+00, + &-0.22532E+00,-0.22465E+00,-0.22398E+00,-0.22332E+00,-0.22265E+00, + &-0.22198E+00,-0.22132E+00,-0.22065E+00,-0.21999E+00,-0.21932E+00, + &-0.21866E+00,-0.21799E+00,-0.21733E+00,-0.21667E+00,-0.21601E+00, + &-0.21534E+00,-0.21468E+00,-0.21402E+00,-0.21336E+00,-0.21270E+00, + &-0.21204E+00,-0.21138E+00,-0.21072E+00,-0.21006E+00,-0.20941E+00, + &-0.20875E+00,-0.20809E+00,-0.20743E+00,-0.20678E+00,-0.20612E+00, + &-0.20547E+00,-0.20481E+00,-0.20416E+00,-0.20350E+00,-0.20285E+00, + &-0.20219E+00,-0.20154E+00,-0.20089E+00,-0.20024E+00,-0.19958E+00, + &-0.19893E+00,-0.19828E+00,-0.19763E+00,-0.19698E+00,-0.19633E+00, + &-0.19568E+00,-0.19503E+00,-0.19438E+00,-0.19374E+00,-0.19309E+00, + &-0.19244E+00,-0.19179E+00,-0.19115E+00,-0.19050E+00,-0.18986E+00, + &-0.18921E+00,-0.18857E+00,-0.18792E+00,-0.18728E+00,-0.18663E+00, + &-0.18599E+00,-0.18535E+00,-0.18470E+00,-0.18406E+00,-0.18342E+00/ + + DATA (BNC13M (I),I=501,600)/ + &-0.18278E+00,-0.18214E+00,-0.18150E+00,-0.18086E+00,-0.18022E+00, + &-0.17958E+00,-0.17894E+00,-0.17830E+00,-0.17766E+00,-0.17703E+00, + &-0.17639E+00,-0.17575E+00,-0.17511E+00,-0.17448E+00,-0.17384E+00, + &-0.17321E+00,-0.17257E+00,-0.17194E+00,-0.17130E+00,-0.17067E+00, + &-0.17004E+00,-0.16940E+00,-0.16877E+00,-0.16814E+00,-0.16751E+00, + &-0.16687E+00,-0.16624E+00,-0.16561E+00,-0.16498E+00,-0.16435E+00, + &-0.16372E+00,-0.16309E+00,-0.16247E+00,-0.16184E+00,-0.16121E+00, + &-0.16058E+00,-0.15995E+00,-0.15933E+00,-0.15870E+00,-0.15807E+00, + &-0.15745E+00,-0.15682E+00,-0.15620E+00,-0.15557E+00,-0.15495E+00, + &-0.15432E+00,-0.15370E+00,-0.15308E+00,-0.15245E+00,-0.15183E+00, + &-0.15121E+00,-0.15059E+00,-0.14997E+00,-0.14935E+00,-0.14873E+00, + &-0.14811E+00,-0.14749E+00,-0.14687E+00,-0.14625E+00,-0.14563E+00, + &-0.14501E+00,-0.14439E+00,-0.14377E+00,-0.14316E+00,-0.14254E+00, + &-0.14192E+00,-0.14131E+00,-0.14069E+00,-0.14007E+00,-0.13946E+00, + &-0.13885E+00,-0.13823E+00,-0.13762E+00,-0.13700E+00,-0.13639E+00, + &-0.13578E+00,-0.13516E+00,-0.13455E+00,-0.13394E+00,-0.13333E+00, + &-0.13272E+00,-0.13211E+00,-0.13149E+00,-0.13088E+00,-0.13027E+00, + &-0.12966E+00,-0.12906E+00,-0.12845E+00,-0.12784E+00,-0.12723E+00, + &-0.12662E+00,-0.12601E+00,-0.12541E+00,-0.12480E+00,-0.12419E+00, + &-0.12359E+00,-0.12298E+00,-0.12238E+00,-0.12177E+00,-0.11951E+00/ + + DATA (BNC13M (I),I=601,700)/ + &-0.11454E+00,-0.10855E+00,-0.10259E+00,-0.96662E-01,-0.90768E-01, + &-0.84905E-01,-0.79073E-01,-0.73271E-01,-0.67500E-01,-0.61758E-01, + &-0.56045E-01,-0.50361E-01,-0.44704E-01,-0.39075E-01,-0.33474E-01, + &-0.27900E-01,-0.22352E-01,-0.16830E-01,-0.11333E-01,-0.58624E-02, + &-0.41641E-03, 0.50053E-02, 0.10403E-01, 0.15776E-01, 0.21127E-01, + & 0.26453E-01, 0.31758E-01, 0.37040E-01, 0.42299E-01, 0.47537E-01, + & 0.52753E-01, 0.57948E-01, 0.63123E-01, 0.68276E-01, 0.73409E-01, + & 0.78522E-01, 0.83615E-01, 0.88689E-01, 0.93744E-01, 0.98779E-01, + & 0.10380E+00, 0.10879E+00, 0.11377E+00, 0.11874E+00, 0.12368E+00, + & 0.12861E+00, 0.13352E+00, 0.13841E+00, 0.14328E+00, 0.14814E+00, + & 0.15298E+00, 0.15781E+00, 0.16262E+00, 0.16741E+00, 0.17219E+00, + & 0.17695E+00, 0.18170E+00, 0.18643E+00, 0.19115E+00, 0.19585E+00, + & 0.20054E+00, 0.20521E+00, 0.20987E+00, 0.21452E+00, 0.21915E+00, + & 0.22376E+00, 0.22837E+00, 0.23296E+00, 0.23753E+00, 0.24210E+00, + & 0.24665E+00, 0.25119E+00, 0.25571E+00, 0.26022E+00, 0.26472E+00, + & 0.26921E+00, 0.27369E+00, 0.27815E+00, 0.28260E+00, 0.28704E+00, + & 0.29147E+00, 0.29589E+00, 0.30029E+00, 0.30468E+00, 0.30907E+00, + & 0.31344E+00, 0.31780E+00, 0.32215E+00, 0.32649E+00, 0.33081E+00, + & 0.33513E+00, 0.33944E+00, 0.34374E+00, 0.34802E+00, 0.35230E+00, + & 0.35656E+00, 0.36082E+00, 0.36507E+00, 0.36930E+00, 0.37353E+00/ + + DATA (BNC13M(I),I=701,741)/ + & 0.37775E+00, 0.38196E+00, 0.38616E+00, 0.39035E+00, 0.39453E+00, + & 0.39870E+00, 0.40286E+00, 0.40701E+00, 0.41116E+00, 0.41529E+00, + & 0.41942E+00, 0.42354E+00, 0.42764E+00, 0.43175E+00, 0.43584E+00, + & 0.43992E+00, 0.44400E+00, 0.44807E+00, 0.45213E+00, 0.45618E+00, + & 0.46022E+00, 0.46426E+00, 0.46828E+00, 0.47230E+00, 0.47632E+00, + & 0.48032E+00, 0.48432E+00, 0.48831E+00, 0.49229E+00, 0.49626E+00, + & 0.50023E+00, 0.50419E+00, 0.50814E+00, 0.51209E+00, 0.51603E+00, + & 0.51996E+00, 0.52388E+00, 0.52780E+00, 0.53171E+00, 0.53562E+00, + & 0.53951E+00 + & / + END + +CC************************************************************************* +CC +CC TOOLBOX LIBRARY v.1.0 (May 1995) +CC +CC Program unit : SUBROUTINE CHRBLN +CC Purpose : Position of last non-blank character in a string +CC Author : Athanasios Nenes +CC +CC ======================= ARGUMENTS / USAGE ============================= +CC +CC STR is the CHARACTER variable containing the string examined +CC IBLK is a INTEGER variable containing the position of last non +CC blank character. If string is all spaces (ie ' '), then +CC the value returned is 1. +CC +CC EXAMPLE: +CC STR = 'TEST1.DAT ' +CC CALL CHRBLN (STR, IBLK) +CC +CC after execution of this code segment, "IBLK" has the value "9", which +CC is the position of the last non-blank character of "STR". +CC +CC*********************************************************************** +CC + SUBROUTINE CHRBLN (STR, IBLK) +CC +CC*********************************************************************** + CHARACTER*(*) STR +C + IBLK = 1 ! Substring pointer (default=1) + ILEN = LEN(STR) ! Length of string + DO 10 i=ILEN,1,-1 + IF (STR(i:i).NE.' ' .AND. STR(i:i).NE.CHAR(0)) THEN + IBLK = i + RETURN + ENDIF +10 CONTINUE + RETURN +C + END + + +CC************************************************************************* +CC +CC TOOLBOX LIBRARY v.1.0 (May 1995) +CC +CC Program unit : SUBROUTINE SHFTRGHT +CC Purpose : RIGHT-JUSTIFICATION FUNCTION ON A STRING +CC Author : Athanasios Nenes +CC +CC ======================= ARGUMENTS / USAGE ============================= +CC +CC STRING is the CHARACTER variable with the string to be justified +CC +CC EXAMPLE: +CC STRING = 'AAAA ' +CC CALL SHFTRGHT (STRING) +CC +CC after execution of this code segment, STRING contains the value +CC ' AAAA'. +CC +CC************************************************************************* +CC + SUBROUTINE SHFTRGHT (CHR) +CC +CC*********************************************************************** + CHARACTER CHR*(*) +C + I1 = LEN(CHR) ! Total length of string + CALL CHRBLN(CHR,I2) ! Position of last non-blank character + IF (I2.EQ.I1) RETURN +C + DO 10 I=I2,1,-1 ! Shift characters + CHR(I1+I-I2:I1+I-I2) = CHR(I:I) + CHR(I:I) = ' ' +10 CONTINUE + RETURN +C + END + + + + +CC************************************************************************* +CC +CC TOOLBOX LIBRARY v.1.0 (May 1995) +CC +CC Program unit : SUBROUTINE RPLSTR +CC Purpose : REPLACE CHARACTERS OCCURING IN A STRING +CC Author : Athanasios Nenes +CC +CC ======================= ARGUMENTS / USAGE ============================= +CC +CC STRING is the CHARACTER variable with the string to be edited +CC OLD is the old character which is to be replaced +CC NEW is the new character which OLD is to be replaced with +CC IERR is 0 if everything went well, is 1 if 'NEW' contains 'OLD'. +CC In this case, this is invalid, and no change is done. +CC +CC EXAMPLE: +CC STRING = 'AAAA' +CC OLD = 'A' +CC NEW = 'B' +CC CALL RPLSTR (STRING, OLD, NEW) +CC +CC after execution of this code segment, STRING contains the value +CC 'BBBB'. +CC +CC************************************************************************* +CC + SUBROUTINE RPLSTR (STRING, OLD, NEW, IERR) +CC +CC*********************************************************************** + CHARACTER STRING*(*), OLD*(*), NEW*(*) +C +C *** INITIALIZE ******************************************************** +C + ILO = LEN(OLD) +C +C *** CHECK AND SEE IF 'NEW' CONTAINS 'OLD', WHICH CANNOT *************** +C + IP = INDEX(NEW,OLD) + IF (IP.NE.0) THEN + IERR = 1 + RETURN + ELSE + IERR = 0 + ENDIF +C +C *** PROCEED WITH REPLACING ******************************************* +C +10 IP = INDEX(STRING,OLD) ! SEE IF 'OLD' EXISTS IN 'STRING' + IF (IP.EQ.0) RETURN ! 'OLD' DOES NOT EXIST ; RETURN + STRING(IP:IP+ILO-1) = NEW ! REPLACE SUBSTRING 'OLD' WITH 'NEW' + GOTO 10 ! GO FOR NEW OCCURANCE OF 'OLD' +C + END + + +CC************************************************************************* +CC +CC TOOLBOX LIBRARY v.1.0 (May 1995) +CC +CC Program unit : SUBROUTINE INPTD +CC Purpose : Prompts user for a value (DOUBLE). A default value +CC is provided, so if user presses , the default +CC is used. +CC Author : Athanasios Nenes +CC +CC ======================= ARGUMENTS / USAGE ============================= +CC +CC VAR is the DOUBLE PRECISION variable which value is to be saved +CC DEF is a DOUBLE PRECISION variable, with the default value of VAR. +CC PROMPT is a CHARACTER varible containing the prompt string. +CC PRFMT is a CHARACTER variable containing the FORMAT specifier +CC for the default value DEF. +CC IERR is an INTEGER error flag, and has the values: +CC 0 - No error detected. +CC 1 - Invalid FORMAT and/or Invalid default value. +CC 2 - Bad value specified by user +CC +CC EXAMPLE: +CC CALL INPTD (VAR, 1.0D0, 'Give value for A ', '*', Ierr) +CC +CC after execution of this code segment, the user is prompted for the +CC value of variable VAR. If is pressed (ie no value is specified) +CC then 1.0 is assigned to VAR. The default value is displayed in free- +CC format. The error status is specified by variable Ierr +CC +CC*********************************************************************** +CC + SUBROUTINE INPTD (VAR, DEF, PROMPT, PRFMT, IERR) +CC +CC*********************************************************************** + CHARACTER PROMPT*(*), PRFMT*(*), BUFFER*128 + DOUBLE PRECISION DEF, VAR + INTEGER IERR +C + IERR = 0 +C +C *** WRITE DEFAULT VALUE TO WORK BUFFER ******************************* +C + WRITE (BUFFER, FMT=PRFMT, ERR=10) DEF + CALL CHRBLN (BUFFER, IEND) +C +C *** PROMPT USER FOR INPUT AND READ IT ******************************** +C + WRITE (*,*) PROMPT,' [',BUFFER(1:IEND),']: ' + READ (*, '(A)', ERR=20, END=20) BUFFER + CALL CHRBLN (BUFFER,IEND) +C +C *** READ DATA OR SET DEFAULT ? **************************************** +C + IF (IEND.EQ.1 .AND. BUFFER(1:1).EQ.' ') THEN + VAR = DEF + ELSE + READ (BUFFER, *, ERR=20, END=20) VAR + ENDIF +C +C *** RETURN POINT ****************************************************** +C +30 RETURN +C +C *** ERROR HANDLER ***************************************************** +C +10 IERR = 1 ! Bad FORMAT and/or bad default value + GOTO 30 +C +20 IERR = 2 ! Bad number given by user + GOTO 30 +C + END + + +CC************************************************************************* +CC +CC TOOLBOX LIBRARY v.1.0 (May 1995) +CC +CC Program unit : SUBROUTINE Pushend +CC Purpose : Positions the pointer of a sequential file at its end +CC Simulates the ACCESS='APPEND' clause of a F77L OPEN +CC statement with Standard Fortran commands. +CC +CC ======================= ARGUMENTS / USAGE ============================= +CC +CC Iunit is a INTEGER variable, the file unit which the file is +CC connected to. +CC +CC EXAMPLE: +CC CALL PUSHEND (10) +CC +CC after execution of this code segment, the pointer of unit 10 is +CC pushed to its end. +CC +CC*********************************************************************** +CC + SUBROUTINE Pushend (Iunit) +CC +CC*********************************************************************** +C + LOGICAL OPNED +C +C *** INQUIRE IF Iunit CONNECTED TO FILE ******************************** +C + INQUIRE (UNIT=Iunit, OPENED=OPNED) + IF (.NOT.OPNED) GOTO 25 +C +C *** Iunit CONNECTED, PUSH POINTER TO END ****************************** +C +10 READ (Iunit,'()', ERR=20, END=20) + GOTO 10 +C +C *** RETURN POINT ****************************************************** +C +20 BACKSPACE (Iunit) +25 RETURN + END + + + +CC************************************************************************* +CC +CC TOOLBOX LIBRARY v.1.0 (May 1995) +CC +CC Program unit : SUBROUTINE APPENDEXT +CC Purpose : Fix extension in file name string +CC +CC ======================= ARGUMENTS / USAGE ============================= +CC +CC Filename is the CHARACTER variable with the file name +CC Defext is the CHARACTER variable with extension (including '.', +CC ex. '.DAT') +CC Overwrite is a LOGICAL value, .TRUE. overwrites any existing extension +CC in "Filename" with "Defext", .FALSE. puts "Defext" only if +CC there is no extension in "Filename". +CC +CC EXAMPLE: +CC FILENAME1 = 'TEST.DAT' +CC FILENAME2 = 'TEST.DAT' +CC CALL APPENDEXT (FILENAME1, '.TXT', .FALSE.) +CC CALL APPENDEXT (FILENAME2, '.TXT', .TRUE. ) +CC +CC after execution of this code segment, "FILENAME1" has the value +CC 'TEST.DAT', while "FILENAME2" has the value 'TEST.TXT' +CC +CC*********************************************************************** +CC + SUBROUTINE Appendext (Filename, Defext, Overwrite) +CC +CC*********************************************************************** + CHARACTER*(*) Filename, Defext + LOGICAL Overwrite +C + CALL CHRBLN (Filename, Iend) + IF (Filename(1:1).EQ.' ' .AND. Iend.EQ.1) RETURN ! Filename empty + Idot = INDEX (Filename, '.') ! Append extension ? + IF (Idot.EQ.0) Filename = Filename(1:Iend)//Defext + IF (Overwrite .AND. Idot.NE.0) + & Filename = Filename(:Idot-1)//Defext + RETURN + END + + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE POLY3 +C *** FINDS THE REAL ROOTS OF THE THIRD ORDER ALGEBRAIC EQUATION: +C X**3 + A1*X**2 + A2*X + A3 = 0.0 +C THE EQUATION IS SOLVED ANALYTICALLY. +C +C PARAMETERS A1, A2, A3 ARE SPECIFIED BY THE USER. THE MINIMUM +C NONEGATIVE ROOT IS RETURNED IN VARIABLE 'ROOT'. IF NO ROOT IS +C FOUND (WHICH IS GREATER THAN ZERO), ROOT HAS THE VALUE 1D30. +C AND THE FLAG ISLV HAS A VALUE GREATER THAN ZERO. +C +C SOLUTION FORMULA IS FOUND IN PAGE 32 OF: +C MATHEMATICAL HANDBOOK OF FORMULAS AND TABLES +C SCHAUM'S OUTLINE SERIES +C MURRAY SPIEGER, McGRAW-HILL, NEW YORK, 1968 +C (GREEK TRANSLATION: BY SOTIRIOS PERSIDES, ESPI, ATHENS, 1976) +C +C A SPECIAL CASE IS CONSIDERED SEPERATELY ; WHEN A3 = 0, THEN +C ONE ROOT IS X=0.0, AND THE OTHER TWO FROM THE SOLUTION OF THE +C QUADRATIC EQUATION X**2 + A1*X + A2 = 0.0 +C THIS SPECIAL CASE IS CONSIDERED BECAUSE THE ANALYTICAL FORMULA +C DOES NOT YIELD ACCURATE RESULTS (DUE TO NUMERICAL ROUNDOFF ERRORS) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE POLY3 (A1, A2, A3, ROOT, ISLV) +C + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (EXPON=1.D0/3.D0, ZERO=0.D0, THET1=120.D0/180.D0, + & THET2=240.D0/180.D0, PI=3.141592653589793D0, EPS=1D-50) + DOUBLE PRECISION X(3) +C +C *** SPECIAL CASE : QUADRATIC*X EQUATION ***************************** +C + IF (ABS(A3).LE.EPS) THEN + ISLV = 1 + IX = 1 + X(1) = ZERO + D = A1*A1-4.D0*A2 + IF (D.GE.ZERO) THEN + IX = 3 + SQD = SQRT(D) + X(2) = 0.5D0*(-A1+SQD) + X(3) = 0.5D0*(-A1-SQD) + ENDIF + ELSE +C +C *** NORMAL CASE : CUBIC EQUATION ************************************ +C +C DEFINE PARAMETERS Q, R, S, T, D +C + ISLV= 1 + Q = (3.D0*A2 - A1*A1)/9.D0 + R = (9.D0*A1*A2 - 27.D0*A3 - 2.D0*A1*A1*A1)/54.D0 + D = Q*Q*Q + R*R +C +C *** CALCULATE ROOTS ************************************************* +C +C D < 0, THREE REAL ROOTS +C + IF (D.LT.-EPS) THEN ! D < -EPS : D < ZERO + IX = 3 + THET = EXPON*ACOS(R/SQRT(-Q*Q*Q)) + COEF = 2.D0*SQRT(-Q) + X(1) = COEF*COS(THET) - EXPON*A1 + X(2) = COEF*COS(THET + THET1*PI) - EXPON*A1 + X(3) = COEF*COS(THET + THET2*PI) - EXPON*A1 +C +C D = 0, THREE REAL (ONE DOUBLE) ROOTS +C + ELSE IF (D.LE.EPS) THEN ! -EPS <= D <= EPS : D = ZERO + IX = 2 + SSIG = SIGN (1.D0, R) + S = SSIG*(ABS(R))**EXPON + X(1) = 2.D0*S - EXPON*A1 + X(2) = -S - EXPON*A1 +C +C D > 0, ONE REAL ROOT +C + ELSE ! D > EPS : D > ZERO + IX = 1 + SQD = SQRT(D) + SSIG = SIGN (1.D0, R+SQD) ! TRANSFER SIGN TO SSIG + TSIG = SIGN (1.D0, R-SQD) + S = SSIG*(ABS(R+SQD))**EXPON ! EXPONENTIATE ABS() + T = TSIG*(ABS(R-SQD))**EXPON + X(1) = S + T - EXPON*A1 + ENDIF + ENDIF +C +C *** SELECT APPROPRIATE ROOT ***************************************** +C + ROOT = 1.D30 + DO 10 I=1,IX + IF (X(I).GT.ZERO) THEN + ROOT = MIN (ROOT, X(I)) + ISLV = 0 + ENDIF +10 CONTINUE +C +C *** END OF SUBROUTINE POLY3 ***************************************** +C + + RETURN + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE POLY3B +C *** FINDS A REAL ROOT OF THE THIRD ORDER ALGEBRAIC EQUATION: +C X**3 + A1*X**2 + A2*X + A3 = 0.0 +C THE EQUATION IS SOLVED NUMERICALLY (BISECTION). +C +C PARAMETERS A1, A2, A3 ARE SPECIFIED BY THE USER. THE MINIMUM +C NONEGATIVE ROOT IS RETURNED IN VARIABLE 'ROOT'. IF NO ROOT IS +C FOUND (WHICH IS GREATER THAN ZERO), ROOT HAS THE VALUE 1D30. +C AND THE FLAG ISLV HAS A VALUE GREATER THAN ZERO. +C +C RTLW, RTHI DEFINE THE INTERVAL WHICH THE ROOT IS LOOKED FOR. +C +C======================================================================= +C + SUBROUTINE POLY3B (A1, A2, A3, RTLW, RTHI, ROOT, ISLV) +C + IMPLICIT DOUBLE PRECISION (A-H, O-Z) + PARAMETER (ZERO=0.D0, EPS=1D-15, MAXIT=100, NDIV=5) +C + FUNC(X) = X**3.d0 + A1*X**2.0 + A2*X + A3 +C +C *** INITIAL VALUES FOR BISECTION ************************************* +C + X1 = RTLW + Y1 = FUNC(X1) + IF (ABS(Y1).LE.EPS) THEN ! Is low a root? + ROOT = RTLW + GOTO 50 + ENDIF +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** +C + DX = (RTHI-RTLW)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNC (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + IF (ABS(Y2) .LT. EPS) THEN ! X2 is a root + ROOT = X2 + ELSE + ROOT = 1.d30 + ISLV = 1 + ENDIF + GOTO 50 +C +C *** BISECTION ******************************************************* +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNC (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE +C +C *** CONVERGED ; RETURN *********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNC (X3) + ROOT = X3 + ISLV = 0 +C +50 RETURN +C +C *** END OF SUBROUTINE POLY3B ***************************************** +C + END + + + +ccc PROGRAM DRIVER +ccc DOUBLE PRECISION ROOT +cccC +ccc CALL POLY3 (-1.d0, 1.d0, -1.d0, ROOT, ISLV) +ccc IF (ISLV.NE.0) STOP 'Error in POLY3' +ccc WRITE (*,*) 'Root=', ROOT +cccC +ccc CALL POLY3B (-1.d0, 1.d0, -1.d0, -10.d0, 10.d0, ROOT, ISLV) +ccc IF (ISLV.NE.0) STOP 'Error in POLY3B' +ccc WRITE (*,*) 'Root=', ROOT +cccC +ccc END +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION EX10 +C *** 10^X FUNCTION ; ALTERNATE OF LIBRARY ROUTINE ; USED BECAUSE IT IS +C MUCH FASTER BUT WITHOUT GREAT LOSS IN ACCURACY. , +C MAXIMUM ERROR IS 2%, EXECUTION TIME IS 42% OF THE LIBRARY ROUTINE +C (ON A 80286/80287 MACHINE, using Lahey FORTRAN 77 v.3.0). +C +C EXPONENT RANGE IS BETWEEN -K AND K (K IS THE REAL ARGUMENT 'K') +C MAX VALUE FOR K: 9.999 +C IF X < -K, X IS SET TO -K, IF X > K, X IS SET TO K +C +C THE EXPONENT IS CALCULATED BY THE PRODUCT ADEC*AINT, WHERE ADEC +C IS THE MANTISSA AND AINT IS THE MAGNITUDE (EXPONENT). BOTH +C MANTISSA AND MAGNITUDE ARE PRE-CALCULATED AND STORED IN LOOKUP +C TABLES ; THIS LEADS TO THE INCREASED SPEED. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + FUNCTION EX10(X,K) + REAL X, EX10, Y, AINT10, ADEC10, K + INTEGER K1, K2 + COMMON /EXPNC/ AINT10(20), ADEC10(200) +C +C *** LIMIT X TO [-K, K] RANGE ***************************************** +C + Y = MAX(-K, MIN(X,K)) ! MIN: -9.999, MAX: 9.999 +C +C *** GET INTEGER AND DECIMAL PART ************************************* +C + K1 = INT(Y) + K2 = INT(100*(Y-K1)) +C +C *** CALCULATE EXP FUNCTION ******************************************* +C + EX10 = AINT10(K1+10)*ADEC10(K2+100) +C +C *** END OF EXP FUNCTION ********************************************** +C + RETURN + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** BLOCK DATA EXPON +C *** CONTAINS DATA FOR EXPONENT ARRAYS NEEDED IN FUNCTION EXP10 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + BLOCK DATA EXPON +C +C *** Common block definition +C + REAL AINT10, ADEC10 + COMMON /EXPNC/ AINT10(20), ADEC10(200) +C +C *** Integer part +C + DATA AINT10/ + & 0.1000E-08, 0.1000E-07, 0.1000E-06, 0.1000E-05, 0.1000E-04, + & 0.1000E-03, 0.1000E-02, 0.1000E-01, 0.1000E+00, 0.1000E+01, + & 0.1000E+02, 0.1000E+03, 0.1000E+04, 0.1000E+05, 0.1000E+06, + & 0.1000E+07, 0.1000E+08, 0.1000E+09, 0.1000E+10, 0.1000E+11 + & / +C +C *** decimal part +C + DATA (ADEC10(I),I=1,100)/ + & 0.1023E+00, 0.1047E+00, 0.1072E+00, 0.1096E+00, 0.1122E+00, + & 0.1148E+00, 0.1175E+00, 0.1202E+00, 0.1230E+00, 0.1259E+00, + & 0.1288E+00, 0.1318E+00, 0.1349E+00, 0.1380E+00, 0.1413E+00, + & 0.1445E+00, 0.1479E+00, 0.1514E+00, 0.1549E+00, 0.1585E+00, + & 0.1622E+00, 0.1660E+00, 0.1698E+00, 0.1738E+00, 0.1778E+00, + & 0.1820E+00, 0.1862E+00, 0.1905E+00, 0.1950E+00, 0.1995E+00, + & 0.2042E+00, 0.2089E+00, 0.2138E+00, 0.2188E+00, 0.2239E+00, + & 0.2291E+00, 0.2344E+00, 0.2399E+00, 0.2455E+00, 0.2512E+00, + & 0.2570E+00, 0.2630E+00, 0.2692E+00, 0.2754E+00, 0.2818E+00, + & 0.2884E+00, 0.2951E+00, 0.3020E+00, 0.3090E+00, 0.3162E+00, + & 0.3236E+00, 0.3311E+00, 0.3388E+00, 0.3467E+00, 0.3548E+00, + & 0.3631E+00, 0.3715E+00, 0.3802E+00, 0.3890E+00, 0.3981E+00, + & 0.4074E+00, 0.4169E+00, 0.4266E+00, 0.4365E+00, 0.4467E+00, + & 0.4571E+00, 0.4677E+00, 0.4786E+00, 0.4898E+00, 0.5012E+00, + & 0.5129E+00, 0.5248E+00, 0.5370E+00, 0.5495E+00, 0.5623E+00, + & 0.5754E+00, 0.5888E+00, 0.6026E+00, 0.6166E+00, 0.6310E+00, + & 0.6457E+00, 0.6607E+00, 0.6761E+00, 0.6918E+00, 0.7079E+00, + & 0.7244E+00, 0.7413E+00, 0.7586E+00, 0.7762E+00, 0.7943E+00, + & 0.8128E+00, 0.8318E+00, 0.8511E+00, 0.8710E+00, 0.8913E+00, + & 0.9120E+00, 0.9333E+00, 0.9550E+00, 0.9772E+00, 0.1000E+01/ + + DATA (ADEC10(I),I=101,200)/ + & 0.1023E+01, 0.1047E+01, 0.1072E+01, 0.1096E+01, 0.1122E+01, + & 0.1148E+01, 0.1175E+01, 0.1202E+01, 0.1230E+01, 0.1259E+01, + & 0.1288E+01, 0.1318E+01, 0.1349E+01, 0.1380E+01, 0.1413E+01, + & 0.1445E+01, 0.1479E+01, 0.1514E+01, 0.1549E+01, 0.1585E+01, + & 0.1622E+01, 0.1660E+01, 0.1698E+01, 0.1738E+01, 0.1778E+01, + & 0.1820E+01, 0.1862E+01, 0.1905E+01, 0.1950E+01, 0.1995E+01, + & 0.2042E+01, 0.2089E+01, 0.2138E+01, 0.2188E+01, 0.2239E+01, + & 0.2291E+01, 0.2344E+01, 0.2399E+01, 0.2455E+01, 0.2512E+01, + & 0.2570E+01, 0.2630E+01, 0.2692E+01, 0.2754E+01, 0.2818E+01, + & 0.2884E+01, 0.2951E+01, 0.3020E+01, 0.3090E+01, 0.3162E+01, + & 0.3236E+01, 0.3311E+01, 0.3388E+01, 0.3467E+01, 0.3548E+01, + & 0.3631E+01, 0.3715E+01, 0.3802E+01, 0.3890E+01, 0.3981E+01, + & 0.4074E+01, 0.4169E+01, 0.4266E+01, 0.4365E+01, 0.4467E+01, + & 0.4571E+01, 0.4677E+01, 0.4786E+01, 0.4898E+01, 0.5012E+01, + & 0.5129E+01, 0.5248E+01, 0.5370E+01, 0.5495E+01, 0.5623E+01, + & 0.5754E+01, 0.5888E+01, 0.6026E+01, 0.6166E+01, 0.6310E+01, + & 0.6457E+01, 0.6607E+01, 0.6761E+01, 0.6918E+01, 0.7079E+01, + & 0.7244E+01, 0.7413E+01, 0.7586E+01, 0.7762E+01, 0.7943E+01, + & 0.8128E+01, 0.8318E+01, 0.8511E+01, 0.8710E+01, 0.8913E+01, + & 0.9120E+01, 0.9333E+01, 0.9550E+01, 0.9772E+01, 0.1000E+02 + & / +C +C *** END OF BLOCK DATA EXPON ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISOPLUS +C *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA-PLUS +C THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSION 1.0) +C +C *** NOTE: THIS SUBROUTINE IS INCLUDED FOR BACKWARD COMPATABILITY ONLY. +C A PROGRAMMER SHOULD USE THE MORE COMPLETE SUBROUTINE ISOROPIA INSTEAD +C +C ======================== ARGUMENTS / USAGE =========================== +C +C INPUT: +C 1. [WI] +C DOUBLE PRECISION array of length [5]. +C Concentrations, expressed in moles/m3. Depending on the type of +C problem solved, WI contains either GAS+AEROSOL or AEROSOL only +C concentratios. +C WI(1) - sodium +C WI(2) - sulfate +C WI(3) - ammonium +C WI(4) - nitrate +C WI(5) - chloride +C +C 2. [RHI] +C DOUBLE PRECISION variable. +C Ambient relative humidity expressed in a (0,1) scale. +C +C 3. [TEMPI] +C DOUBLE PRECISION variable. +C Ambient temperature expressed in Kelvins. +C +C 4. [IPROB] +C INTEGER variable. +C The type of problem solved. +C IPROB = 0 - Forward problem is solved. In this case, array WI +C contains GAS and AEROSOL concentrations together. +C IPROB = 1 - Reverse problem is solved. In this case, array WI +C contains AEROSOL concentrations only. +C +C OUTPUT: +C 1. [GAS] +C DOUBLE PRECISION array of length [03]. +C Gaseous species concentrations, expressed in moles/m3. +C GAS(1) - NH3 +C GAS(2) - HNO3 +C GAS(3) - HCl +C +C 2. [AERLIQ] +C DOUBLE PRECISION array of length [11]. +C Liquid aerosol species concentrations, expressed in moles/m3. +C AERLIQ(01) - H+(aq) +C AERLIQ(02) - Na+(aq) +C AERLIQ(03) - NH4+(aq) +C AERLIQ(04) - Cl-(aq) +C AERLIQ(05) - SO4--(aq) +C AERLIQ(06) - HSO4-(aq) +C AERLIQ(07) - NO3-(aq) +C AERLIQ(08) - H2O +C AERLIQ(09) - NH3(aq) (undissociated) +C AERLIQ(10) - HNCl(aq) (undissociated) +C AERLIQ(11) - HNO3(aq) (undissociated) +C +C 3. [AERSLD] +C DOUBLE PRECISION array of length [09]. +C Solid aerosol species concentrations, expressed in moles/m3. +C AERSLD(01) - NaNO3(s) +C AERSLD(02) - NH4NO3(s) +C AERSLD(03) - NaCl(s) +C AERSLD(04) - NH4Cl(s) +C AERSLD(05) - Na2SO4(s) +C AERSLD(06) - (NH4)2SO4(s) +C AERSLD(07) - NaHSO4(s) +C AERSLD(08) - NH4HSO4(s) +C AERSLD(09) - (NH4)4H(SO4)2(s) +C +C 4. [DRY] +C LOGICAL variable. +C Contains information about the physical state of the system. +C .TRUE. - There is no aqueous phase present +C .FALSE.- There is an aqueous phase present +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISOPLUS (WI, RHI, TEMPI, IPROBI, + & GAS, AERLIQ, AERSLD, DRYI ) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP), GAS(NGASAQ), AERLIQ(NIONS+NGASAQ+1), + & AERSLD(NSLDS) + LOGICAL DRYI +C +C *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ****************************** +C + IPROB = IPROBI +C +C *** SOLVE FOREWARD PROBLEM ******************************************** +C + IF (IPROB.EQ.0) THEN + IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0 + CALL INIT1 (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN ! Na,Cl,NO3=0 + CALL ISRP1F (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(5) .LE. TINY) THEN ! Na,Cl=0 + CALL ISRP2F (WI, RHI, TEMPI) + ELSE + CALL ISRP3F (WI, RHI, TEMPI) + ENDIF +C +C *** SOLVE REVERSE PROBLEM ********************************************* +C + ELSE + IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0 + CALL INIT1 (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN ! Na,Cl,NO3=0 + CALL ISRP1R (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(5) .LE. TINY) THEN ! Na,Cl=0 + CALL ISRP2R (WI, RHI, TEMPI) + ELSE + CALL ISRP3R (WI, RHI, TEMPI) + ENDIF + ENDIF +C +C *** SAVE RESULTS TO ARRAYS (units = mole/m3, kg/m3 for water) ********* +C + GAS(1) = GNH3 + GAS(2) = GHNO3 + GAS(3) = GHCL +C + DO 10 I=1,NIONS + AERLIQ(I) = MOLAL(I) + 10 CONTINUE + AERLIQ(NIONS+1) = WATER*1.0D3/18.0D0 + DO 20 I=1,NGASAQ + AERLIQ(NIONS+1+I) = GASAQ(I) + 20 CONTINUE +C + AERSLD(1) = CNANO3 + AERSLD(2) = CNH4NO3 + AERSLD(3) = CNACL + AERSLD(4) = CNH4CL + AERSLD(5) = CNA2SO4 + AERSLD(6) = CNH42S4 + AERSLD(7) = CNAHSO4 + AERSLD(8) = CNH4HS4 + AERSLD(9) = CLC +C + DRYI = WATER.LE.TINY +C + RETURN +C +C *** END OF SUBROUTINE ISOPLUS ****************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRPIA +C *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA-PLUS +C THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSIONS 0.x) +C +C *** NOTE: THIS SUBROUTINE IS INCLUDED FOR BACKWARD COMPATABILITY ONLY. +C A PROGRAMMER SHOULD USE THE MORE COMPLETE SUBROUTINE ISOROPIA INSTEAD +C +C +C DEPENDING ON THE INPUT VALUES PROVIDED, THE FOLLOWING MODEL +C SUBVERSIONS ARE CALLED: +C +C FOREWARD PROBLEM (IPROB=0): +C Na SO4 NH4 NO3 CL SUBROUTINE CALLED +C ---- ---- ---- ---- ---- ----------------- +C 0.0 >0.0 >0.0 0.0 0.0 SUBROUTINE ISRP1F +C 0.0 >0.0 >0.0 >0.0 0.0 SUBROUTINE ISRP2F +C >0.0 >0.0 >0.0 >0.0 >0.0 SUBROUTINE ISRP3F +C +C REVERSE PROBLEM (IPROB=1): +C Na SO4 NH4 NO3 CL SUBROUTINE CALLED +C ---- ---- ---- ---- ---- ----------------- +C 0.0 >0.0 >0.0 0.0 0.0 SUBROUTINE ISRP1R +C 0.0 >0.0 >0.0 >0.0 0.0 SUBROUTINE ISRP2R +C >0.0 >0.0 >0.0 >0.0 >0.0 SUBROUTINE ISRP3R +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISRPIA (WI, RHI, TEMPI, IPROBI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) +C +C *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ****************************** +C + IPROB = IPROBI +C +C *** SOLVE FOREWARD PROBLEM ******************************************** +C + IF (IPROB.EQ.0) THEN + IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0 + CALL INIT1 (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN ! Na,Cl,NO3=0 + CALL ISRP1F (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(5) .LE. TINY) THEN ! Na,Cl=0 + CALL ISRP2F (WI, RHI, TEMPI) + ELSE + CALL ISRP3F (WI, RHI, TEMPI) + ENDIF +C +C *** SOLVE REVERSE PROBLEM ********************************************* +C + ELSE + IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0 + CALL INIT1 (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN ! Na,Cl,NO3=0 + CALL ISRP1R (WI, RHI, TEMPI) + ELSE IF (WI(1)+WI(5) .LE. TINY) THEN ! Na,Cl=0 + CALL ISRP2R (WI, RHI, TEMPI) + ELSE + CALL ISRP3R (WI, RHI, TEMPI) + ENDIF + ENDIF +C +C *** SETUP 'DRY' FLAG *************************************************** +C + DRYF = WATER.LE.TINY +C +C *** FIND TOTALS ******************************************************* +C + IF (IPROB.EQ.0) THEN + CONTINUE + ELSE + W(1) = WAER(1) + W(2) = WAER(2) + W(3) = WAER(3) + W(4) = WAER(4) + W(5) = WAER(5) +C + IF (.NOT.DRYF) THEN + W(3) = W(3) + GNH3 + W(4) = W(4) + GHNO3 + W(5) = W(5) + GHCL + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE ISRPIA ******************************************* +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE PUSHERR +C *** THIS SUBROUTINE SAVES AN ERROR MESSAGE IN THE ERROR STACK +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE PUSHERR (IERR,ERRINF) + INCLUDE 'isrpia.inc' + CHARACTER ERRINF*(*) +C +C *** SAVE ERROR CODE IF THERE IS ANY SPACE *************************** +C + IF (NOFER.LT.NERRMX) THEN + NOFER = NOFER + 1 + ERRSTK(NOFER) = IERR + ERRMSG(NOFER) = ERRINF + STKOFL =.FALSE. + ELSE + STKOFL =.TRUE. ! STACK OVERFLOW + ENDIF +C +C *** END OF SUBROUTINE PUSHERR **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISERRINF +C *** THIS SUBROUTINE OBTAINS A COPY OF THE ERROR STACK (& MESSAGES) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISERRINF (ERRSTKI, ERRMSGI, NOFERI, STKOFLI) + INCLUDE 'isrpia.inc' + CHARACTER ERRMSGI*40 + INTEGER ERRSTKI + LOGICAL STKOFLI + DIMENSION ERRMSGI(NERRMX), ERRSTKI(NERRMX) +C +C *** OBTAIN WHOLE ERROR STACK **************************************** +C + DO 10 I=1,NOFER ! Error messages & codes + ERRSTKI(I) = ERRSTK(I) + ERRMSGI(I) = ERRMSG(I) + 10 CONTINUE +C + STKOFLI = STKOFL + NOFERI = NOFER +C + RETURN +C +C *** END OF SUBROUTINE ISERRINF *************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ERRSTAT +C *** THIS SUBROUTINE REPORTS ERROR MESSAGES TO UNIT 'IO' +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ERRSTAT (IO,IERR,ERRINF) + INCLUDE 'isrpia.inc' + CHARACTER CER*4, NCIS*29, NCIF*27, NSIS*26, NSIF*24, ERRINF*(*) + DATA NCIS /'NO CONVERGENCE IN SUBROUTINE '/, + & NCIF /'NO CONVERGENCE IN FUNCTION ' /, + & NSIS /'NO SOLUTION IN SUBROUTINE ' /, + & NSIF /'NO SOLUTION IN FUNCTION ' / +C +C *** WRITE ERROR IN CHARACTER ***************************************** +C + WRITE (CER,'(I4)') IERR + CALL RPLSTR (CER, ' ', '0',IOK) ! REPLACE BLANKS WITH ZEROS + CALL CHRBLN (ERRINF, IEND) ! LAST POSITION OF ERRINF CHAR +C +C *** WRITE ERROR TYPE (FATAL, WARNING ) ******************************* +C + IF (IERR.EQ.0) THEN + WRITE (IO,1000) 'NO ERRORS DETECTED ' + GOTO 10 +C + ELSE IF (IERR.LT.0) THEN + WRITE (IO,1000) 'ERROR STACK EXHAUSTED ' + GOTO 10 +C + ELSE IF (IERR.GT.1000) THEN + WRITE (IO,1100) 'FATAL',CER +C + ELSE + WRITE (IO,1100) 'WARNING',CER + ENDIF +C +C *** WRITE ERROR MESSAGE ********************************************** +C +C FATAL MESSAGES +C + IF (IERR.EQ.1001) THEN + CALL CHRBLN (SCASE, IEND) + WRITE (IO,1000) 'CASE NOT SUPPORTED IN CALCMR ['//SCASE(1:IEND) + & //']' +C + ELSEIF (IERR.EQ.1002) THEN + CALL CHRBLN (SCASE, IEND) + WRITE (IO,1000) 'CASE NOT SUPPORTED ['//SCASE(1:IEND)//']' +C +C WARNING MESSAGES +C + ELSEIF (IERR.EQ.0001) THEN + WRITE (IO,1000) NSIS,ERRINF +C + ELSEIF (IERR.EQ.0002) THEN + WRITE (IO,1000) NCIS,ERRINF +C + ELSEIF (IERR.EQ.0003) THEN + WRITE (IO,1000) NSIF,ERRINF +C + ELSEIF (IERR.EQ.0004) THEN + WRITE (IO,1000) NCIF,ERRINF +C + ELSE IF (IERR.EQ.0019) THEN + WRITE (IO,1000) 'HNO3(aq) AFFECTS H+, WHICH '// + & 'MIGHT AFFECT SO4/HSO4 RATIO' + WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %' +C + ELSE IF (IERR.EQ.0020) THEN + IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN + WRITE (IO,1000) 'HSO4-SO4 EQUILIBRIUM MIGHT AFFECT HNO3,' + & //'HCL DISSOLUTION' + ELSE + WRITE (IO,1000) 'HSO4-SO4 EQUILIBRIUM MIGHT AFFECT NH3 ' + & //'DISSOLUTION' + ENDIF + WRITE (IO,1000) 'DIRECT DECREASE IN H+ [',ERRINF(1:IEND),'] %' +C + ELSE IF (IERR.EQ.0021) THEN + WRITE (IO,1000) 'HNO3(aq),HCL(aq) AFFECT H+, WHICH '// + & 'MIGHT AFFECT SO4/HSO4 RATIO' + WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %' +C + ELSE IF (IERR.EQ.0022) THEN + WRITE (IO,1000) 'HCL(g) EQUILIBRIUM YIELDS NONPHYSICAL '// + & 'DISSOLUTION' + WRITE (IO,1000) 'A TINY AMOUNT [',ERRINF(1:IEND),'] IS '// + & 'ASSUMED TO BE DISSOLVED' +C + ELSEIF (IERR.EQ.0033) THEN + WRITE (IO,1000) 'HCL(aq) AFFECTS H+, WHICH '// + & 'MIGHT AFFECT SO4/HSO4 RATIO' + WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %' +C + ELSEIF (IERR.EQ.0050) THEN + WRITE (IO,1000) 'TOO MUCH SODIUM GIVEN AS INPUT.' + WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.' + WRITE (IO,1000) 'EXCESS SODIUM IS IGNORED.' +C + ELSE + WRITE (IO,1000) 'NO DIAGNOSTIC MESSAGE AVAILABLE' + ENDIF +C +10 RETURN +C +C *** FORMAT STATEMENTS ************************************* +C +1000 FORMAT (1X,A:A:A:A:A) +1100 FORMAT (1X,A,' ERROR [',A4,']:') +C +C *** END OF SUBROUTINE ERRSTAT ***************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISORINF +C *** THIS SUBROUTINE PROVIDES INFORMATION ABOUT ISORROPIA +C +C ======================== ARGUMENTS / USAGE =========================== +C +C OUTPUT: +C 1. [VERSI] +C CHARACTER*15 variable. +C Contains version-date information of ISORROPIA +C +C 2. [NCMP] +C INTEGER variable. +C The number of components needed in input array WI +C (or, the number of major species accounted for by ISORROPIA) +C +C 3. [NION] +C INTEGER variable +C The number of ions considered in the aqueous phase +C +C 4. [NAQGAS] +C INTEGER variable +C The number of undissociated species found in aqueous aerosol +C phase +C +C 5. [NSOL] +C INTEGER variable +C The number of solids considered in the solid aerosol phase +C +C 6. [NERR] +C INTEGER variable +C The size of the error stack (maximum number of errors that can +C be stored before the stack exhausts). +C +C 7. [TIN] +C DOUBLE PRECISION variable +C The value used for a very small number. +C +C 8. [GRT] +C DOUBLE PRECISION variable +C The value used for a very large number. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISORINF (VERSI, NCMP, NION, NAQGAS, NSOL, NERR, TIN, + & GRT) + INCLUDE 'isrpia.inc' + CHARACTER VERSI*(*) +C +C *** ASSIGN INFO ******************************************************* +C + VERSI = VERSION + NCMP = NCOMP + NION = NIONS + NAQGAS = NGASAQ + NSOL = NSLDS + NERR = NERRMX + TIN = TINY + GRT = GREAT +C + RETURN +C +C *** END OF SUBROUTINE ISORINF ******************************************* +C + END diff --git a/models/CCTM/aero/blank/isofwd.f b/models/CCTM/aero/blank/isofwd.f new file mode 100755 index 0000000..c2d3530 --- /dev/null +++ b/models/CCTM/aero/blank/isofwd.f @@ -0,0 +1,6591 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/isofwd.f,v 1.2 2011/10/21 16:10:05 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C This is ISORROPIA Version 1.7 (3/15/06). More information is available +C at the ISORROPIA homepage: http://nenes.eas.gatech.edu/ISORROPIA/ +C +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRP1F +C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF +C AN AMMONIUM-SULFATE AEROSOL SYSTEM. +C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY +C THE AMBIENT RELATIVE HUMIDITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISRP1F (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) +C +C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** +C + CALL INIT1 (WI, RHI, TEMPI) +C +C *** CALCULATE SULFATE RATIO ******************************************* +C + SULRAT = W(3)/W(2) +C +C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** +C +C *** SULFATE POOR +C + IF (2.0.LE.SULRAT) THEN + DC = W(3) - 2.001D0*W(2) ! For numerical stability + W(3) = W(3) + MAX(-DC, ZERO) +C + IF(METSTBL.EQ.1) THEN + SCASE = 'A2' + CALL CALCA2 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH42S4) THEN + SCASE = 'A1' + CALL CALCA1 ! NH42SO4 ; case A1 +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'A2' + CALL CALCA2 ! Only liquid ; case A2 + ENDIF + ENDIF +C +C *** SULFATE RICH (NO ACID) +C + ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'B1' + CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case B1 +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN + SCASE = 'B2' + CALL CALCB2 ! LC,NH42S4 ; case B2 +C + ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'B3' + CALL CALCB3 ! NH42S4 ; case B3 +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid ; case B4 + ENDIF + ENDIF + CALL CALCNH3 +C +C *** SULFATE RICH (FREE ACID) +C + ELSEIF (SULRAT.LT.1.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'C1' + CALL CALCC1 ! NH4HSO4 ; case C1 +C + ELSEIF (DRNH4HS4.LE.RH) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid ; case C2 +C + ENDIF + ENDIF + CALL CALCNH3 + ENDIF +C +C *** RETURN POINT +C + RETURN +C +C *** END OF SUBROUTINE ISRP1F ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRP2F +C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF +C AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. +C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY +C THE AMBIENT RELATIVE HUMIDITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISRP2F (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) +C +C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** +C + CALL INIT2 (WI, RHI, TEMPI) +C +C *** CALCULATE SULFATE RATIO ******************************************* +C + SULRAT = W(3)/W(2) +C +C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** +C +C *** SULFATE POOR +C + IF (2.0.LE.SULRAT) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'D3' + CALL CALCD3 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4NO3) THEN + SCASE = 'D1' + CALL CALCD1 ! NH42SO4,NH4NO3 ; case D1 +C + ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'D2' + CALL CALCD2 ! NH42S4 ; case D2 +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'D3' + CALL CALCD3 ! Only liquid ; case D3 + ENDIF + ENDIF +C +C *** SULFATE RICH (NO ACID) +C FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES, +C THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. +C SUBROUTINES CALCB? ARE CALLED, AND THEN THE NITRIC ACID IS DISSOLVED +C FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM. +C + ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid (metastable) + SCASE = 'E4' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'B1' + CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case E1 + SCASE = 'E1' +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN + SCASE = 'B2' + CALL CALCB2 ! LC,NH42S4 ; case E2 + SCASE = 'E2' +C + ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'B3' + CALL CALCB3 ! NH42S4 ; case E3 + SCASE = 'E3' +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid ; case E4 + SCASE = 'E4' + ENDIF + ENDIF +C + CALL CALCNA ! HNO3(g) DISSOLUTION +C +C *** SULFATE RICH (FREE ACID) +C FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES, +C THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM +C SUBROUTINE CALCC? IS CALLED, AND THEN THE NITRIC ACID IS DISSOLVED +C FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM. +C + ELSEIF (SULRAT.LT.1.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid (metastable) + SCASE = 'F2' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'C1' + CALL CALCC1 ! NH4HSO4 ; case F1 + SCASE = 'F1' +C + ELSEIF (DRNH4HS4.LE.RH) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid ; case F2 + SCASE = 'F2' + ENDIF + ENDIF +C + CALL CALCNA ! HNO3(g) DISSOLUTION + ENDIF +C +C *** RETURN POINT +C + RETURN +C +C *** END OF SUBROUTINE ISRP2F ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRP3F +C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF +C AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. +C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM +C RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE ISRP3F (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) +C +C *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** +C + WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 + WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3 +C +C *** ADJUST FOR TOO LITTLE SODIUM, SULFATE AND NITRATE COMBINED ******** +C + IF (WI(1)+WI(2)+WI(4) .LE. 1d-10) THEN + WI(1) = 1.D-10 ! Na+ : 1e-4 umoles/m3 + WI(2) = 1.D-10 ! SO4- : 1e-4 umoles/m3 + ENDIF +C +C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** +C + CALL ISOINIT3 (WI, RHI, TEMPI) +C +C *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE ********* +C + REST = 2.D0*W(2) + W(4) + W(5) + IF (W(1).GT.REST) THEN ! NA > 2*SO4+CL+NO3 ? + W(1) = (ONE-1D-6)*REST ! Adjust Na amount + CALL PUSHERR (0050, 'ISRP3F') ! Warning error: Na adjusted + ENDIF +C +C *** CALCULATE SULFATE & SODIUM RATIOS ********************************* +C + SULRAT = (W(1)+W(3))/W(2) + SODRAT = W(1)/W(2) +C +C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** +C +C *** SULFATE POOR ; SODIUM POOR +C + IF (2.0.LE.SULRAT .AND. SODRAT.LT.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'G5' + CALL CALCG5 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4NO3) THEN + SCASE = 'G1' + CALL CALCG1 ! NH42SO4,NH4NO3,NH4CL,NA2SO4 +C + ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN + SCASE = 'G2' + CALL CALCG2 ! NH42SO4,NH4CL,NA2SO4 +C + ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'G3' + CALL CALCG3 ! NH42SO4,NA2SO4 +C + ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN + SCASE = 'G4' + CALL CALCG4 ! NA2SO4 +C + ELSEIF (DRNA2SO4.LE.RH) THEN + SCASE = 'G5' + CALL CALCG5 ! Only liquid + ENDIF + ENDIF +C +C *** SULFATE POOR ; SODIUM RICH +C + ELSE IF (SULRAT.GE.2.0 .AND. SODRAT.GE.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'H6' + CALL CALCH6 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4NO3) THEN + SCASE = 'H1' + CALL CALCH1 ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3 +C + ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN + SCASE = 'H2' + CALL CALCH2 ! NH4CL,NA2SO4,NACL,NANO3 +C + ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN + SCASE = 'H3' + CALL CALCH3 ! NH4CL,NA2SO4,NACL +C + ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4Cl) THEN + SCASE = 'H4' + CALL CALCH4 ! NH4CL,NA2SO4 +C + ELSEIF (DRNH4Cl.LE.RH .AND. RH.LT.DRNA2SO4) THEN + SCASE = 'H5' + CALL CALCH5 ! NA2SO4 +C + ELSEIF (DRNA2SO4.LE.RH) THEN + SCASE = 'H6' + CALL CALCH6 ! NO SOLID + ENDIF + ENDIF +C +C *** SULFATE RICH (NO ACID) +C + ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'I6' + CALL CALCI6 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'I1' + CALL CALCI1 ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN + SCASE = 'I2' + CALL CALCI2 ! NA2SO4,(NH4)2SO4,NAHSO4,LC +C + ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN + SCASE = 'I3' + CALL CALCI3 ! NA2SO4,(NH4)2SO4,LC +C + ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'I4' + CALL CALCI4 ! NA2SO4,(NH4)2SO4 +C + ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN + SCASE = 'I5' + CALL CALCI5 ! NA2SO4 +C + ELSEIF (DRNA2SO4.LE.RH) THEN + SCASE = 'I6' + CALL CALCI6 ! NO SOLIDS + ENDIF + ENDIF +C + CALL CALCNHA ! MINOR SPECIES: HNO3, HCl + CALL CALCNH3 ! NH3 +C +C *** SULFATE RICH (FREE ACID) +C + ELSEIF (SULRAT.LT.1.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'J3' + CALL CALCJ3 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'J1' + CALL CALCJ1 ! NH4HSO4,NAHSO4 +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN + SCASE = 'J2' + CALL CALCJ2 ! NAHSO4 +C + ELSEIF (DRNAHSO4.LE.RH) THEN + SCASE = 'J3' + CALL CALCJ3 + ENDIF + ENDIF +C + CALL CALCNHA ! MINOR SPECIES: HNO3, HCl + CALL CALCNH3 ! NH3 + ENDIF +C +C *** RETURN POINT +C + RETURN +C +C *** END OF SUBROUTINE ISRP3F ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCA2 +C *** CASE A2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. LIQUID AEROSOL PHASE ONLY POSSIBLE +C +C FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS X, THE +C AMOUNT OF HYDROGEN IONS (H+) FOUND IN THE LIQUID PHASE. +C FOR EACH ESTIMATION OF H+, FUNCTION FUNCB2A CALCULATES THE +C CONCENTRATION OF IONS FROM THE NH3(GAS) - NH4+(LIQ) EQUILIBRIUM. +C ELECTRONEUTRALITY IS USED AS THE OBJECTIVE FUNCTION. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCA2 + INCLUDE 'isrpia.inc' +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU =.TRUE. ! Outer loop activity calculation flag + OMELO = TINY ! Low limit: SOLUTION IS VERY BASIC + OMEHI = 2.0D0*W(2) ! High limit: FROM NH4+ -> NH3(g) + H+(aq) +C +C *** CALCULATE WATER CONTENT ***************************************** +C + MOLAL(5) = W(2) + MOLAL(6) = ZERO + CALL CALCMR +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = OMEHI + Y1 = FUNCA2 (X1) + IF (ABS(Y1).LE.EPS) RETURN +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (OMEHI-OMELO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = MAX(X1-DX, OMELO) + Y2 = FUNCA2 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE + IF (ABS(Y2).LE.EPS) THEN + RETURN + ELSE + CALL PUSHERR (0001, 'CALCA2') ! WARNING ERROR: NO SOLUTION + RETURN + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCA2 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCA2') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCA2 (X3) + RETURN +C +C *** END OF SUBROUTINE CALCA2 **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCA2 +C *** CASE A2 +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE A2 ; +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA2. +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCA2 (OMEGI) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION LAMDA +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. + PSI = W(2) ! INITIAL AMOUNT OF (NH4)2SO4 IN SOLUTION +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + A2 = XK2*R*TEMP/XKW*(GAMA(8)/GAMA(9))**2. + A3 = XKW*RH*WATER*WATER +C + LAMDA = PSI/(A1/OMEGI+ONE) + ZETA = A3/OMEGI +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (1) = OMEGI ! HI + MOLAL (3) = W(3)/(ONE/A2/OMEGI + ONE) ! NH4I + MOLAL (5) = MAX(PSI-LAMDA,TINY) ! SO4I + MOLAL (6) = LAMDA ! HSO4I + GNH3 = MAX (W(3)-MOLAL(3), TINY) ! NH3GI + COH = ZETA ! OHI +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 DENOM = (2.0*MOLAL(5)+MOLAL(6)) + FUNCA2= (MOLAL(3)/DENOM - ONE) + MOLAL(1)/DENOM + RETURN +C +C *** END OF FUNCTION FUNCA2 ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCA1 +C *** CASE A1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4 +C +C A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4 +C IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN +C THE GAS PHASE. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCA1 + INCLUDE 'isrpia.inc' +C + CNH42S4 = W(2) + GNH3 = MAX (W(3)-2.0*CNH42S4, ZERO) + RETURN +C +C *** END OF SUBROUTINE CALCA1 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB4 +C *** CASE B4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. LIQUID AEROSOL PHASE ONLY POSSIBLE +C +C FOR CALCULATIONS, A BISECTION IS PERFORMED WITH RESPECT TO H+. +C THE OBJECTIVE FUNCTION IS THE DIFFERENCE BETWEEN THE ESTIMATED H+ +C AND THAT CALCULATED FROM ELECTRONEUTRALITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB4 + INCLUDE 'isrpia.inc' +C +C *** SOLVE EQUATIONS ************************************************** +C + FRST = .TRUE. + CALAIN = .TRUE. + CALAOU = .TRUE. +C +C *** CALCULATE WATER CONTENT ****************************************** +C + CALL CALCB1A ! GET DRY SALT CONTENT, AND USE FOR WATER. + MOLALR(13) = CLC + MOLALR(9) = CNH4HS4 + MOLALR(4) = CNH42S4 + CLC = ZERO + CNH4HS4 = ZERO + CNH42S4 = ZERO + WATER = MOLALR(13)/M0(13)+MOLALR(9)/M0(9)+MOLALR(4)/M0(4) +C + MOLAL(3) = W(3) ! NH4I +C + DO 20 I=1,NSWEEP + AK1 = XK1*((GAMA(8)/GAMA(7))**2.)*(WATER/GAMA(7)) + BET = W(2) + GAM = MOLAL(3) +C + BB = BET + AK1 - GAM + CC =-AK1*BET + DD = BB*BB - 4.D0*CC +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (5) = MAX(TINY,MIN(0.5*(-BB + SQRT(DD)), W(2))) ! SO4I + MOLAL (6) = MAX(TINY,MIN(W(2)-MOLAL(5),W(2))) ! HSO4I + MOLAL (1) = MAX(TINY,MIN(AK1*MOLAL(6)/MOLAL(5),W(2))) ! HI + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (.NOT.CALAIN) GOTO 30 + CALL CALCACT +20 CONTINUE +C +30 RETURN +C +C *** END OF SUBROUTINE CALCB4 ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB3 +C *** CASE B3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE +C 3. SOLIDS POSSIBLE: (NH4)2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB3 + INCLUDE 'isrpia.inc' +C +C *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 *********************** +C + X = MAX(2*W(2)-W(3), ZERO) ! Equivalent NH4HSO4 + Y = MAX(W(3) -W(2), ZERO) ! Equivalent NH42SO4 +C +C *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 ********* +C + IF (X.LT.Y) THEN ! LC is the MIN (x,y) + SCASE = 'B3 ; SUBCASE 1' + TLC = X + TNH42S4 = Y-X + CALL CALCB3A (TLC,TNH42S4) ! LC + (NH4)2SO4 + ELSE + SCASE = 'B3 ; SUBCASE 2' + TLC = Y + TNH4HS4 = X-Y + CALL CALCB3B (TLC,TNH4HS4) ! LC + NH4HSO4 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCB3 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB3A +C *** CASE B3 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH (1.0 < SULRAT < 2.0) +C 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE +C 3. SOLIDS POSSIBLE: (NH4)2SO4 +C +C FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE +C AMOUNT OF SOLID (NH4)2SO4 DISSOLVED IN THE LIQUID PHASE. +C FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB3A CALCULATES THE +C AMOUNT OF H+ PRODUCED (BASED ON THE SO4 RELEASED INTO THE +C SOLUTION). THE SOLUBILITY PRODUCT OF (NH4)2SO4 IS USED AS THE +C OBJECTIVE FUNCTION. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB3A (TLC, TNH42S4) + INCLUDE 'isrpia.inc' +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + ZLO = ZERO ! MIN DISSOLVED (NH4)2SO4 + ZHI = TNH42S4 ! MAX DISSOLVED (NH4)2SO4 +C +C *** INITIAL VALUES FOR BISECTION (DISSOLVED (NH4)2SO4 **************** +C + Z1 = ZLO + Y1 = FUNCB3A (Z1, TLC, TNH42S4) + IF (ABS(Y1).LE.EPS) RETURN + YLO= Y1 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** +C + DZ = (ZHI-ZLO)/FLOAT(NDIV) + DO 10 I=1,NDIV + Z2 = Z1+DZ + Y2 = FUNCB3A (Z2, TLC, TNH42S4) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + Z1 = Z2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + YHI= Y1 ! Save Y-value at HI position + IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + RETURN +C +C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC +C + ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN + Z1 = ZHI + Z2 = ZHI + GOTO 40 +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC +C + ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + Z1 = ZLO + Z2 = ZLO + GOTO 40 + ELSE + CALL PUSHERR (0001, 'CALCB3A') ! WARNING ERROR: NO SOLUTION + RETURN + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + Z3 = 0.5*(Z1+Z2) + Y3 = FUNCB3A (Z3, TLC, TNH42S4) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + Z2 = Z3 + ELSE + Y1 = Y3 + Z1 = Z3 + ENDIF + IF (ABS(Z2-Z1) .LE. EPS*Z1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCB3A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ************************************************ +C +40 ZK = 0.5*(Z1+Z2) + Y3 = FUNCB3A (ZK, TLC, TNH42S4) +C + RETURN +C +C *** END OF SUBROUTINE CALCB3A ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCB3A +C *** CASE B3 ; SUBCASE 1 +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B3 +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA3. +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCB3A (ZK, Y, X) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION KK +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + FRST = .TRUE. + CALAIN = .TRUE. + DO 20 I=1,NSWEEP + GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + DD = SQRT( (ZK+GRAT1+Y)**2. + 4.0*Y*GRAT1) + KK = 0.5*(-(ZK+GRAT1+Y) + DD ) +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (1) = KK ! HI + MOLAL (5) = KK+ZK+Y ! SO4I + MOLAL (6) = MAX (Y-KK, TINY) ! HSO4I + MOLAL (3) = 3.0*Y+2*ZK ! NH4I + CNH42S4 = X-ZK ! Solid (NH4)2SO4 + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 30 + ENDIF +20 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +CCC30 FUNCB3A= ( SO4I*NH4I**2.0 )/( XK7*(WATER/GAMA(4))**3.0 ) +30 FUNCB3A= MOLAL(5)*MOLAL(3)**2.0 + FUNCB3A= FUNCB3A/(XK7*(WATER/GAMA(4))**3.0) - ONE + RETURN +C +C *** END OF FUNCTION FUNCB3A ******************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB3B +C *** CASE B3 ; SUBCASE 2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH (1.0 < SULRAT < 2.0) +C 2. LIQUID PHASE ONLY IS POSSIBLE +C +C SPECIATION CALCULATIONS IS BASED ON THE HSO4 <--> SO4 EQUILIBRIUM. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB3B (Y, X) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION KK +C + CALAOU = .FALSE. ! Outer loop activity calculation flag + FRST = .FALSE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 20 I=1,NSWEEP + GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + DD = SQRT( (GRAT1+Y)**2. + 4.0*(X+Y)*GRAT1) + KK = 0.5*(-(GRAT1+Y) + DD ) +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (1) = KK ! HI + MOLAL (5) = Y+KK ! SO4I + MOLAL (6) = MAX (X+Y-KK, TINY) ! HSO4I + MOLAL (3) = 3.0*Y+X ! NH4I + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (.NOT.CALAIN) GOTO 30 + CALL CALCACT +20 CONTINUE +C +30 RETURN +C +C *** END OF SUBROUTINE CALCB3B ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB2 +C *** CASE B2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : LC, (NH4)2SO4 +C +C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON THE SULFATE RATIO: +C 1. WHEN BOTH LC AND (NH4)2SO4 ARE POSSIBLE (SUBROUTINE CALCB2A) +C 2. WHEN ONLY LC IS POSSIBLE (SUBROUTINE CALCB2B). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB2 + INCLUDE 'isrpia.inc' +C +C *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 *********************** +C + X = MAX(2*W(2)-W(3), TINY) ! Equivalent NH4HSO4 + Y = MAX(W(3) -W(2), TINY) ! Equivalent NH42SO4 +C +C *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 ********* +C + IF (X.LE.Y) THEN ! LC is the MIN (x,y) + SCASE = 'B2 ; SUBCASE 1' + CALL CALCB2A (X,Y-X) ! LC + (NH4)2SO4 POSSIBLE + ELSE + SCASE = 'B2 ; SUBCASE 2' + CALL CALCB2B (Y,X-Y) ! LC ONLY POSSIBLE + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCB2 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB2 +C *** CASE B2 ; SUBCASE A. +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH (1.0 < SULRAT < 2.0) +C 2. SOLID PHASE ONLY POSSIBLE +C 3. SOLIDS POSSIBLE: LC, (NH4)2SO4 +C +C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: +C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE +C +C FOR SOLID CALCULATIONS, A MATERIAL BALANCE BASED ON THE STOICHIMETRIC +C PROPORTION OF AMMONIUM AND SULFATE IS DONE TO CALCULATE THE AMOUNT +C OF LC AND (NH4)2SO4 IN THE SOLID PHASE. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB2A (TLC, TNH42S4) + INCLUDE 'isrpia.inc' +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMLCAS) THEN + SCASE = 'B2 ; SUBCASE A1' ! SOLIDS POSSIBLE ONLY + CLC = TLC + CNH42S4 = TNH42S4 + SCASE = 'B2 ; SUBCASE A1' + ELSE + SCASE = 'B2 ; SUBCASE A2' + CALL CALCB2A2 (TLC, TNH42S4) ! LIQUID & SOLID PHASE POSSIBLE + SCASE = 'B2 ; SUBCASE A2' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCB2A ***************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB2A2 +C *** CASE B2 ; SUBCASE A2. +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH (1.0 < SULRAT < 2.0) +C 2. SOLID PHASE ONLY POSSIBLE +C 3. SOLIDS POSSIBLE: LC, (NH4)2SO4 +C +C THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL +C DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED +C SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB2A1) AND THE +C THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB3). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB2A2 (TLC, TNH42S4) + INCLUDE 'isrpia.inc' +C +C *** FIND WEIGHT FACTOR ********************************************** +C + IF (WFTYP.EQ.0) THEN + WF = ZERO + ELSEIF (WFTYP.EQ.1) THEN + WF = 0.5D0 + ELSE + WF = (DRLC-RH)/(DRLC-DRMLCAS) + ENDIF + ONEMWF = ONE - WF +C +C *** FIND FIRST SECTION ; DRY ONE ************************************ +C + CLCO = TLC ! FIRST (DRY) SOLUTION + CNH42SO = TNH42S4 +C +C *** FIND SECOND SECTION ; DRY & LIQUID ****************************** +C + CLC = ZERO + CNH42S4 = ZERO + CALL CALCB3 ! SECOND (LIQUID) SOLUTION +C +C *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. +C + MOLAL(1)= ONEMWF*MOLAL(1) ! H+ + MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + 3.D0*(CLCO-CLC)) ! NH4+ + MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC) ! SO4-- + MOLAL(6)= ONEMWF*(CLCO-CLC) ! HSO4- +C + WATER = ONEMWF*WATER +C + CLC = WF*CLCO + ONEMWF*CLC + CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 +C + RETURN +C +C *** END OF SUBROUTINE CALCB2A2 **************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB2 +C *** CASE B2 ; SUBCASE B +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH (1.0 < SULRAT < 2.0) +C 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE +C 3. SOLIDS POSSIBLE: LC +C +C FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE +C AMOUNT OF SOLID LC DISSOLVED IN THE LIQUID PHASE. +C FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB2A CALCULATES THE +C AMOUNT OF H+ PRODUCED (BASED ON THE HSO4, SO4 RELEASED INTO THE +C SOLUTION). THE SOLUBILITY PRODUCT OF LC IS USED AS THE OBJECTIVE +C FUNCTION. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB2B (TLC,TNH4HS4) + INCLUDE 'isrpia.inc' +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + ZLO = ZERO + ZHI = TLC ! High limit: all of it in liquid phase +C +C *** INITIAL VALUES FOR BISECTION ************************************** +C + X1 = ZHI + Y1 = FUNCB2B (X1,TNH4HS4,TLC) + IF (ABS(Y1).LE.EPS) RETURN + YHI= Y1 ! Save Y-value at Hi position +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ************************ +C + DX = (ZHI-ZLO)/NDIV + DO 10 I=1,NDIV + X2 = X1-DX + Y2 = FUNCB2B (X2,TNH4HS4,TLC) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + YLO= Y1 ! Save Y-value at LO position + IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + RETURN +C +C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC +C + ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN + X1 = ZHI + X2 = ZHI + GOTO 40 +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC +C + ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + X1 = ZLO + X2 = ZLO + GOTO 40 + ELSE + CALL PUSHERR (0001, 'CALCB2B') ! WARNING ERROR: NO SOLUTION + RETURN + ENDIF +C +C *** PERFORM BISECTION ************************************************* +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCB2B (X3,TNH4HS4,TLC) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCB2B') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ************************************************ +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCB2B (X3,TNH4HS4,TLC) +C + RETURN +C +C *** END OF SUBROUTINE CALCB2B ***************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCB2B +C *** CASE B2 ; +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B2 ; SUBCASE 2 +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCB2B. +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCB2B (X,TNH4HS4,TLC) + INCLUDE 'isrpia.inc' +C +C *** SOLVE EQUATIONS ************************************************** +C + FRST = .TRUE. + CALAIN = .TRUE. + DO 20 I=1,NSWEEP + GRAT2 = XK1*WATER*(GAMA(8)/GAMA(7))**2./GAMA(7) + PARM = X+GRAT2 + DELTA = PARM*PARM + 4.0*(X+TNH4HS4)*GRAT2 ! Diakrinousa + OMEGA = 0.5*(-PARM + SQRT(DELTA)) ! Thetiki riza (ie:H+>0) +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (1) = OMEGA ! HI + MOLAL (3) = 3.0*X+TNH4HS4 ! NH4I + MOLAL (5) = X+OMEGA ! SO4I + MOLAL (6) = MAX (X+TNH4HS4-OMEGA, TINY) ! HSO4I + CLC = MAX(TLC-X,ZERO) ! Solid LC + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ****************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 30 + ENDIF +20 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************** +C +CCC30 FUNCB2B= ( NH4I**3.*SO4I*HSO4I )/( XK13*(WATER/GAMA(13))**5. ) +30 FUNCB2B= (MOLAL(3)**3.)*MOLAL(5)*MOLAL(6) + FUNCB2B= FUNCB2B/(XK13*(WATER/GAMA(13))**5.) - ONE + RETURN +C +C *** END OF FUNCTION FUNCB2B ******************************************* +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB1 +C *** CASE B1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : LC, (NH4)2SO4, NH4HSO4 +C +C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: +C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCB1A) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB1 + INCLUDE 'isrpia.inc' +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMLCAB) THEN + SCASE = 'B1 ; SUBCASE 1' + CALL CALCB1A ! SOLID PHASE ONLY POSSIBLE + SCASE = 'B1 ; SUBCASE 1' + ELSE + SCASE = 'B1 ; SUBCASE 2' + CALL CALCB1B ! LIQUID & SOLID PHASE POSSIBLE + SCASE = 'B1 ; SUBCASE 2' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCB1 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB1A +C *** CASE B1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH +C 2. THERE IS NO LIQUID PHASE +C 3. SOLIDS POSSIBLE: LC, { (NH4)2SO4 XOR NH4HSO4 } (ONE OF TWO +C BUT NOT BOTH) +C +C A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE AMOUNT OF LC +C IS CALCULATED FROM THE (NH4)2SO4 AND NH4HSO4 WHICH IS LEAST +C ABUNDANT (STOICHIMETRICALLY). THE REMAINING EXCESS OF SALT +C IS MIXED WITH THE LC. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB1A + INCLUDE 'isrpia.inc' +C +C *** SETUP PARAMETERS ************************************************ +C + X = 2*W(2)-W(3) ! Equivalent NH4HSO4 + Y = W(3)-W(2) ! Equivalent (NH4)2SO4 +C +C *** CALCULATE COMPOSITION ******************************************* +C + IF (X.LE.Y) THEN ! LC is the MIN (x,y) + CLC = X ! NH4HSO4 >= (NH4)2S04 + CNH4HS4 = ZERO + CNH42S4 = Y-X + ELSE + CLC = Y ! NH4HSO4 < (NH4)2S04 + CNH4HS4 = X-Y + CNH42S4 = ZERO + ENDIF + RETURN +C +C *** END OF SUBROUTINE CALCB1 ****************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCB1B +C *** CASE B1 ; SUBCASE 2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE: LC, { (NH4)2SO4 XOR NH4HSO4 } (ONE OF TWO +C BUT NOT BOTH) +C +C THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL +C DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED +C SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB1A) AND THE +C THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB2). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCB1B + INCLUDE 'isrpia.inc' +C +C *** FIND WEIGHT FACTOR ********************************************** +C + IF (WFTYP.EQ.0) THEN + WF = ZERO + ELSEIF (WFTYP.EQ.1) THEN + WF = 0.5D0 + ELSE + WF = (DRNH4HS4-RH)/(DRNH4HS4-DRMLCAB) + ENDIF + ONEMWF = ONE - WF +C +C *** FIND FIRST SECTION ; DRY ONE ************************************ +C + CALL CALCB1A + CLCO = CLC ! FIRST (DRY) SOLUTION + CNH42SO = CNH42S4 + CNH4HSO = CNH4HS4 +C +C *** FIND SECOND SECTION ; DRY & LIQUID ****************************** +C + CLC = ZERO + CNH42S4 = ZERO + CNH4HS4 = ZERO + CALL CALCB2 ! SECOND (LIQUID) SOLUTION +C +C *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS. +C + MOLAL(1)= ONEMWF*MOLAL(1) ! H+ + MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + (CNH4HSO-CNH4HS4) + & + 3.D0*(CLCO-CLC)) ! NH4+ + MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC) ! SO4-- + MOLAL(6)= ONEMWF*(CNH4HSO-CNH4HS4 + CLCO-CLC) ! HSO4- +C + WATER = ONEMWF*WATER +C + CLC = WF*CLCO + ONEMWF*CLC + CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4 + CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4 +C + RETURN +C +C *** END OF SUBROUTINE CALCB1B ***************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCC2 +C *** CASE C2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS ONLY A LIQUID PHASE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCC2 + INCLUDE 'isrpia.inc' + DOUBLE PRECISION LAMDA, KAPA +C + CALAOU =.TRUE. ! Outer loop activity calculation flag + FRST =.TRUE. + CALAIN =.TRUE. +C +C *** SOLVE EQUATIONS ************************************************** +C + LAMDA = W(3) ! NH4HSO4 INITIALLY IN SOLUTION + PSI = W(2)-W(3) ! H2SO4 IN SOLUTION + DO 20 I=1,NSWEEP + PARM = WATER*XK1/GAMA(7)*(GAMA(8)/GAMA(7))**2. + BB = PSI+PARM + CC =-PARM*(LAMDA+PSI) + KAPA = 0.5*(-BB+SQRT(BB*BB-4.0*CC)) +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL(1) = PSI+KAPA ! HI + MOLAL(3) = LAMDA ! NH4I + MOLAL(5) = KAPA ! SO4I + MOLAL(6) = MAX(LAMDA+PSI-KAPA, TINY) ! HSO4I + CH2SO4 = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3), ZERO) ! Free H2SO4 + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (.NOT.CALAIN) GOTO 30 + CALL CALCACT +20 CONTINUE +C +30 RETURN +C +C *** END OF SUBROUTINE CALCC2 ***************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCC1 +C *** CASE C1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE: NH4HSO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCC1 + INCLUDE 'isrpia.inc' + DOUBLE PRECISION KLO, KHI +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + KLO = TINY + KHI = W(3) +C +C *** INITIAL VALUES FOR BISECTION ************************************* +C + X1 = KLO + Y1 = FUNCC1 (X1) + IF (ABS(Y1).LE.EPS) GOTO 50 + YLO= Y1 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO *********************** +C + DX = (KHI-KLO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCC1 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2 .LT. ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + YHI= Y2 ! Save Y-value at HI position + IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + GOTO 50 +C +C *** { YLO, YHI } < 0.0 SOLUTION IS ALWAYS UNDERSATURATED WITH NH4HS04 +C + ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN + GOTO 50 +C +C *** { YLO, YHI } > 0.0 SOLUTION IS ALWAYS SUPERSATURATED WITH NH4HS04 +C + ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + X1 = KLO + X2 = KLO + GOTO 40 + ELSE + CALL PUSHERR (0001, 'CALCC1') ! WARNING ERROR: NO SOLUTION + GOTO 50 + ENDIF +C +C *** PERFORM BISECTION OF DISSOLVED NH4HSO4 ************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCC1 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCC1') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN *********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCC1 (X3) +C +50 RETURN +C +C *** END OF SUBROUTINE CALCC1 ***************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCC1 +C *** CASE C1 ; +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE C1 +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCC1. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCC1 (KAPA) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION KAPA, LAMDA +C +C *** SOLVE EQUATIONS ************************************************** +C + FRST = .TRUE. + CALAIN = .TRUE. +C + PSI = W(2)-W(3) + DO 20 I=1,NSWEEP + PAR1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 + PAR2 = XK12*(WATER/GAMA(9))**2.0 + BB = PSI + PAR1 + CC =-PAR1*(PSI+KAPA) + LAMDA = 0.5*(-BB+SQRT(BB*BB-4*CC)) +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************* +C + MOLAL(1) = PSI+LAMDA ! HI + MOLAL(3) = KAPA ! NH4I + MOLAL(5) = LAMDA ! SO4I + MOLAL(6) = MAX (ZERO, PSI+KAPA-LAMDA) ! HSO4I + CNH4HS4 = MAX(W(3)-MOLAL(3), ZERO) ! Solid NH4HSO4 + CH2SO4 = MAX(PSI, ZERO) ! Free H2SO4 + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 30 + ENDIF +20 CONTINUE +C +C *** CALCULATE ZERO FUNCTION ******************************************* +C +CCC30 FUNCC1= (NH4I*HSO4I/PAR2) - ONE +30 FUNCC1= (MOLAL(3)*MOLAL(6)/PAR2) - ONE + RETURN +C +C *** END OF FUNCTION FUNCC1 ******************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCD3 +C *** CASE D3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. THERE IS OLNY A LIQUID PHASE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCD3 + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCD1A +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4NO3 ! Save from CALCD1 run + CHI2 = CNH42S4 + CHI3 = GHNO3 + CHI4 = GNH3 +C + PSI1 = CNH4NO3 ! ASSIGN INITIAL PSI's + PSI2 = CHI2 + PSI3 = ZERO + PSI4 = ZERO +C + MOLAL(5) = ZERO + MOLAL(6) = ZERO + MOLAL(3) = PSI1 + MOLAL(7) = PSI1 + CALL CALCMR ! Initial water +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + PSI4LO = TINY ! Low limit + PSI4HI = CHI4 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C +60 X1 = PSI4LO + Y1 = FUNCD3 (X1) + IF (ABS(Y1).LE.EPS) RETURN + YLO= Y1 ! Save Y-value at HI position +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCD3 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + YHI= Y1 ! Save Y-value at Hi position + IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + RETURN +C +C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3 +C Physically I dont know when this might happen, but I have put this +C branch in for completeness. I assume there is no solution; all NO3 goes to the +C gas phase. +C + ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN + P4 = TINY ! PSI4LO ! CHI4 + YY = FUNCD3(P4) + GOTO 50 +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3 +C This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates +C and goes to the gas phase ; so I redefine the LO and HI limits of PSI4 +C and proceed again with root tracking. +C + ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + PSI4HI = PSI4LO + PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates + IF (PSI4LO.LT.-(PSI1+PSI2)) THEN + CALL PUSHERR (0001, 'CALCD3') ! WARNING ERROR: NO SOLUTION + RETURN + ELSE + MOLAL(5) = ZERO + MOLAL(6) = ZERO + MOLAL(3) = PSI1 + MOLAL(7) = PSI1 + CALL CALCMR ! Initial water + GOTO 60 ! Redo root tracking + ENDIF + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCD3 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*ABS(X1)) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCD3') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCD3 (X3) +C +C *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* +C +50 CONTINUE + IF (MOLAL(1).GT.TINY) THEN + CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) + MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT + MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT + MOLAL(6) = DELTA ! HSO4 EFFECT + ENDIF + RETURN +C +C *** END OF SUBROUTINE CALCD3 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCD3 +C *** CASE D3 +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D3 ; +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD3. +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCD3 (P4) + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. + PSI4 = P4 +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A2 = XK7*(WATER/GAMA(4))**3.0 + A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A7 = XKW *RH*WATER*WATER +C + PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4) + PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4) + PSI3 = MIN(MAX(PSI3, ZERO), CHI3) +C + BB = PSI4 - PSI3 +CCCOLD AHI = 0.5*(-BB + SQRT(BB*BB + 4.d0*A7)) ! This is correct also +CCC AHI =2.0*A7/(BB+SQRT(BB*BB + 4.d0*A7)) ! Avoid overflow when HI->0 + DENM = BB+SQRT(BB*BB + 4.d0*A7) + IF (DENM.LE.TINY) THEN ! Avoid overflow when HI->0 + ABB = ABS(BB) + DENM = (BB+ABB) + 2.0*A7/ABB ! Taylor expansion of SQRT + ENDIF + AHI = 2.0*A7/DENM +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (1) = AHI ! HI + MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2 ! NH4I + MOLAL (5) = PSI2 ! SO4I + MOLAL (6) = ZERO ! HSO4I + MOLAL (7) = PSI3 + PSI1 ! NO3I + CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4 + CNH4NO3 = ZERO ! Solid NH4NO3 + GHNO3 = CHI3 - PSI3 ! Gas HNO3 + GNH3 = CHI4 - PSI4 ! Gas NH3 + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 CONTINUE +CCC FUNCD3= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE + FUNCD3= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE + RETURN +C +C *** END OF FUNCTION FUNCD3 ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCD2 +C *** CASE D2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCD2 + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCD1A +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4NO3 ! Save from CALCD1 run + CHI2 = CNH42S4 + CHI3 = GHNO3 + CHI4 = GNH3 +C + PSI1 = CNH4NO3 ! ASSIGN INITIAL PSI's + PSI2 = CNH42S4 + PSI3 = ZERO + PSI4 = ZERO +C + MOLAL(5) = ZERO + MOLAL(6) = ZERO + MOLAL(3) = PSI1 + MOLAL(7) = PSI1 + CALL CALCMR ! Initial water +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + PSI4LO = TINY ! Low limit + PSI4HI = CHI4 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C +60 X1 = PSI4LO + Y1 = FUNCD2 (X1) + IF (ABS(Y1).LE.EPS) RETURN + YLO= Y1 ! Save Y-value at HI position +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCD2 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) THEN +C +C This is done, in case if Y(PSI4LO)>0, but Y(PSI4LO+DX) < 0 (i.e.undersat) +C + IF (Y1 .LE. Y2) GOTO 20 ! (Y1*Y2.LT.ZERO) + ENDIF + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + YHI= Y1 ! Save Y-value at Hi position + IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + RETURN +C +C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3 +C Physically I dont know when this might happen, but I have put this +C branch in for completeness. I assume there is no solution; all NO3 goes to the +C gas phase. +C + ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN + P4 = TINY ! PSI4LO ! CHI4 + YY = FUNCD2(P4) + GOTO 50 +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3 +C This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates +C and goes to the gas phase ; so I redefine the LO and HI limits of PSI4 +C and proceed again with root tracking. +C + ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + PSI4HI = PSI4LO + PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates + IF (PSI4LO.LT.-(PSI1+PSI2)) THEN + CALL PUSHERR (0001, 'CALCD2') ! WARNING ERROR: NO SOLUTION + RETURN + ELSE + MOLAL(5) = ZERO + MOLAL(6) = ZERO + MOLAL(3) = PSI1 + MOLAL(7) = PSI1 + CALL CALCMR ! Initial water + GOTO 60 ! Redo root tracking + ENDIF + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCD2 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*ABS(X1)) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCD2') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = MIN(X1,X2) ! 0.5*(X1+X2) ! Get "low" side, it's acidic soln. + Y3 = FUNCD2 (X3) +C +C *** CALCULATE HSO4 SPECIATION AND RETURN ******************************* +C +50 CONTINUE + IF (MOLAL(1).GT.TINY) THEN + CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA) + MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT + MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT + MOLAL(6) = DELTA ! HSO4 EFFECT + ENDIF + RETURN +C +C *** END OF SUBROUTINE CALCD2 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCD2 +C *** CASE D2 +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ; +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD2. +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCD2 (P4) + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + CALL RSTGAM ! Reset activity coefficients to 0.1 + FRST = .TRUE. + CALAIN = .TRUE. + PSI4 = P4 + PSI2 = CHI2 +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A2 = XK7*(WATER/GAMA(4))**3.0 + A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A7 = XKW *RH*WATER*WATER +C + IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN + PSI14 = PSI1+PSI4 + CALL POLY3 (PSI14,0.25*PSI14**2.,-A2/4.D0, PSI2, ISLV) ! PSI2 + IF (ISLV.EQ.0) THEN + PSI2 = MIN (PSI2, CHI2) + ELSE + PSI2 = ZERO + ENDIF + ENDIF +C + PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4) + PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4) +ccc PSI3 = MIN(MAX(PSI3, ZERO), CHI3) +C + BB = PSI4-PSI3 ! (BB > 0, acidic solution, <0 alkaline) +C +C Do not change computation scheme for H+, all others did not work well. +C + DENM = BB+SQRT(BB*BB + 4.d0*A7) + IF (DENM.LE.TINY) THEN ! Avoid overflow when HI->0 + ABB = ABS(BB) + DENM = (BB+ABB) + 2.d0*A7/ABB ! Taylor expansion of SQRT + ENDIF + AHI = 2.d0*A7/DENM +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL (1) = AHI ! HI + MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2 ! NH4 + MOLAL (5) = PSI2 ! SO4 + MOLAL (6) = ZERO ! HSO4 + MOLAL (7) = PSI3 + PSI1 ! NO3 + CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4 + CNH4NO3 = ZERO ! Solid NH4NO3 + GHNO3 = CHI3 - PSI3 ! Gas HNO3 + GNH3 = CHI4 - PSI4 ! Gas NH3 + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 CONTINUE +CCC FUNCD2= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE + FUNCD2= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE + RETURN +C +C *** END OF FUNCTION FUNCD2 ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCD1 +C *** CASE D1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 +C +C THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY: +C 1. RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCD1A) +C 2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCD1 + INCLUDE 'isrpia.inc' + EXTERNAL CALCD1A, CALCD2 +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMASAN) THEN + SCASE = 'D1 ; SUBCASE 1' ! SOLID PHASE ONLY POSSIBLE + CALL CALCD1A + SCASE = 'D1 ; SUBCASE 1' + ELSE + SCASE = 'D1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE + CALL CALCMDRH (RH, DRMASAN, DRNH4NO3, CALCD1A, CALCD2) + SCASE = 'D1 ; SUBCASE 2' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCD1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCD1A +C *** CASE D1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 +C +C THE SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3 +C IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF +C NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN +C THE SOLID PHASE. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCD1A + INCLUDE 'isrpia.inc' +C +C *** SETUP PARAMETERS ************************************************ +C + PARM = XK10/(R*TEMP)/(R*TEMP) +C +C *** CALCULATE NH4NO3 THAT VOLATIZES ********************************* +C + CNH42S4 = W(2) + X = MAX(ZERO, MIN(W(3)-2.0*CNH42S4, W(4))) ! MAX NH4NO3 + PS = MAX(W(3) - X - 2.0*CNH42S4, ZERO) + OM = MAX(W(4) - X, ZERO) +C + OMPS = OM+PS + DIAK = SQRT(OMPS*OMPS + 4.0*PARM) ! DIAKRINOUSA + ZE = MIN(X, 0.5*(-OMPS + DIAK)) ! THETIKI RIZA +C +C *** SPECIATION ******************************************************* +C + CNH4NO3 = X - ZE ! Solid NH4NO3 + GNH3 = PS + ZE ! Gas NH3 + GHNO3 = OM + ZE ! Gas HNO3 +C + RETURN +C +C *** END OF SUBROUTINE CALCD1A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG5 +C *** CASE G5 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG5 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = 0.5*W(1) + CHI2 = MAX (W(2)-CHI1, ZERO) + CHI3 = ZERO + CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) + CHI5 = W(4) + CHI6 = W(5) +C + PSI1 = CHI1 + PSI2 = CHI2 + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C + WATER = CHI2/M0(4) + CHI1/M0(2) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCG5A (X1) + IF (CHI6.LE.TINY) GOTO 50 +ccc IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +ccc IF (WATER .LE. TINY) RETURN ! No water +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCG5A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCG5A (X) + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A2 = XK7 *(WATER/GAMA(4))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 + AKK = A4*A6 +C +C CALCULATE DISSOCIATION QUANTITIES +C + IF (CHI5.GE.TINY) THEN + PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) + ELSE + PSI5 = TINY + ENDIF +C +CCC IF(CHI4.GT.TINY) THEN + IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 + DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 + PSI4 =0.5d0*(-BB - SQRT(DD)) + ELSE + PSI4 = TINY + ENDIF +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (2) = 2.0D0*PSI1 ! NAI + MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I + MOLAL (4) = PSI6 ! CLI + MOLAL (5) = PSI2 + PSI1 ! SO4I + MOLAL (6) = ZERO + MOLAL (7) = PSI5 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C + GNH3 = MAX(CHI4 - PSI4, TINY) ! Gas NH3 + GHNO3 = MAX(CHI5 - PSI5, TINY) ! Gas HNO3 + GHCL = MAX(CHI6 - PSI6, TINY) ! Gas HCl +C + CNH42S4 = ZERO ! Solid (NH4)2SO4 + CNH4NO3 = ZERO ! Solid NH4NO3 + CNH4CL = ZERO ! Solid NH4Cl +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCG5A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE +CCC FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCG5A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG4 +C *** CASE G4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG4 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = 0.5*W(1) + CHI2 = MAX (W(2)-CHI1, ZERO) + CHI3 = ZERO + CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) + CHI5 = W(4) + CHI6 = W(5) +C + PSI2 = CHI2 + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C + WATER = CHI2/M0(4) + CHI1/M0(2) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCG4A (X1) + IF (CHI6.LE.TINY) GOTO 50 +CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50 +CCC IF (WATER .LE. TINY) RETURN ! No water +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCG4A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCG4A (X) + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA, NAI, NH4I, NO3I + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI1 = CHI1 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A2 = XK7 *(WATER/GAMA(4))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 +C +C CALCULATE DISSOCIATION QUANTITIES +C + IF (CHI5.GE.TINY) THEN + PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) + ELSE + PSI5 = TINY + ENDIF +C +CCC IF(CHI4.GT.TINY) THEN + IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 + DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma shankar, 19/11/2001 + PSI4 =0.5d0*(-BB - SQRT(DD)) + ELSE + PSI4 = TINY + ENDIF +C +C CALCULATE CONCENTRATIONS +C + NH4I = 2.0*PSI2 + PSI4 + CLI = PSI6 + SO4I = PSI2 + PSI1 + NO3I = PSI5 + NAI = 2.0D0*PSI1 +C + CALL CALCPH(2.d0*SO4I+NO3I+CLI-NAI-NH4I, HI, OHI) +C +C *** Na2SO4 DISSOLUTION +C + IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1 + CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV) + IF (ISLV.EQ.0) THEN + PSI1 = MIN (PSI1, CHI1) + ELSE + PSI1 = ZERO + ENDIF + ELSE + PSI1 = ZERO + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL (1) = HI + MOLAL (2) = NAI + MOLAL (3) = NH4I + MOLAL (4) = CLI + MOLAL (5) = SO4I + MOLAL (6) = ZERO + MOLAL (7) = NO3I +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNA2SO4 = MAX(CHI1-PSI1,ZERO) +C +C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCG4A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE +CCC FUNCG4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCG4A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG3 +C *** CASE G3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG3 + INCLUDE 'isrpia.inc' + EXTERNAL CALCG1A, CALCG4 +C +C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ +C + IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE + SCASE = 'G3 ; SUBCASE 1' + CALL CALCG3A + SCASE = 'G3 ; SUBCASE 1' + ELSE ! NO3, CL NON EXISTANT + SCASE = 'G1 ; SUBCASE 1' + CALL CALCG1A + SCASE = 'G1 ; SUBCASE 1' + ENDIF +C + IF (WATER.LE.TINY) THEN + IF (RH.LT.DRMG3) THEN ! ONLY SOLIDS + WATER = TINY + DO 10 I=1,NIONS + MOLAL(I) = ZERO +10 CONTINUE + CALL CALCG1A + SCASE = 'G3 ; SUBCASE 2' + RETURN + ELSE + SCASE = 'G3 ; SUBCASE 3' ! MDRH REGION (NA2SO4, NH42S4) + CALL CALCMDRH (RH, DRMG3, DRNH42S4, CALCG1A, CALCG4) + SCASE = 'G3 ; SUBCASE 3' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCG3 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG3A +C *** CASE G3 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG3A + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = 0.5*W(1) + CHI2 = MAX (W(2)-CHI1, ZERO) + CHI3 = ZERO + CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) + CHI5 = W(4) + CHI6 = W(5) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C + WATER = TINY +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCG3A (X1) + IF (CHI6.LE.TINY) GOTO 50 +CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50 +CCC IF (WATER .LE. TINY) RETURN ! No water +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCG3A (X2) +C + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCG3A (X) + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI2 = CHI2 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A2 = XK7 *(WATER/GAMA(4))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 +C +C CALCULATE DISSOCIATION QUANTITIES +C + IF (CHI5.GE.TINY) THEN + PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6) + ELSE + PSI5 = TINY + ENDIF +C +CCC IF(CHI4.GT.TINY) THEN + IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4 + DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01 + PSI4 =0.5d0*(-BB - SQRT(DD)) + ELSE + PSI4 = TINY + ENDIF +C + IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN + CALL POLY3 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV) + IF (ISLV.EQ.0) PSI2 = MIN (PSI20, CHI2) + ENDIF +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + MOLAL (2) = ZERO ! Na + MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I + MOLAL (4) = PSI6 ! CLI + MOLAL (5) = PSI2 ! SO4I + MOLAL (6) = ZERO ! HSO4 + MOLAL (7) = PSI5 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +c + GNH3 = MAX(CHI4 - PSI4, TINY) ! Gas NH3 + GHNO3 = MAX(CHI5 - PSI5, TINY) ! Gas HNO3 + GHCL = MAX(CHI6 - PSI6, TINY) ! Gas HCl +C + CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4 + CNH4NO3 = ZERO ! Solid NH4NO3 + CNH4CL = ZERO ! Solid NH4Cl +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCG3A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE +CCC FUNCG3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCG3A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG2 +C *** CASE G2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG2 + INCLUDE 'isrpia.inc' + EXTERNAL CALCG1A, CALCG3A, CALCG4 +C +C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** +C + IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE + SCASE = 'G2 ; SUBCASE 1' + CALL CALCG2A + SCASE = 'G2 ; SUBCASE 1' + ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE + SCASE = 'G1 ; SUBCASE 1' + CALL CALCG1A + SCASE = 'G1 ; SUBCASE 1' + ENDIF +C +C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************ +C + IF (WATER.LE.TINY) THEN + IF (RH.LT.DRMG2) THEN ! ONLY SOLIDS + WATER = TINY + DO 10 I=1,NIONS + MOLAL(I) = ZERO +10 CONTINUE + CALL CALCG1A + SCASE = 'G2 ; SUBCASE 2' + ELSE + IF (W(5).GT. TINY) THEN + SCASE = 'G2 ; SUBCASE 3' ! MDRH (NH4CL, NA2SO4, NH42S4) + CALL CALCMDRH (RH, DRMG2, DRNH4CL, CALCG1A, CALCG3A) + SCASE = 'G2 ; SUBCASE 3' + ENDIF + IF (WATER.LE.TINY .AND. RH.GE.DRMG3) THEN + SCASE = 'G2 ; SUBCASE 4' ! MDRH (NA2SO4, NH42S4) + CALL CALCMDRH (RH, DRMG3, DRNH42S4, CALCG1A, CALCG4) + SCASE = 'G2 ; SUBCASE 4' + ELSE + WATER = TINY + DO 20 I=1,NIONS + MOLAL(I) = ZERO +20 CONTINUE + CALL CALCG1A + SCASE = 'G2 ; SUBCASE 2' + ENDIF + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCG2 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG2A +C *** CASE G2 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG2A + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = 0.5*W(1) + CHI2 = MAX (W(2)-CHI1, ZERO) + CHI3 = ZERO + CHI4 = MAX (W(3)-2.D0*CHI2, ZERO) + CHI5 = W(4) + CHI6 = W(5) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY +C + WATER = TINY +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCG2A (X1) + IF (CHI6.LE.TINY) GOTO 50 +CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +CCC IF (WATER .LE. TINY) GOTO 50 ! No water +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCG2A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCG2A (X) + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA + COMMON /CASEG/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, + & A1, A2, A3, A4, A5, A6, A7 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI2 = CHI2 + PSI3 = ZERO + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A2 = XK7 *(WATER/GAMA(4))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 +C + DENO = MAX(CHI6-PSI6-PSI3, ZERO) + PSI5 = CHI5/((A6/A5)*(DENO/PSI6) + ONE) +C + PSI4 = MIN(PSI5+PSI6,CHI4) +C + IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN + CALL POLY3 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV) + IF (ISLV.EQ.0) PSI2 = MIN (PSI20, CHI2) + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL (2) = ZERO ! NA + MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I + MOLAL (4) = PSI6 ! CLI + MOLAL (5) = PSI2 ! SO4I + MOLAL (6) = ZERO ! HSO4 + MOLAL (7) = PSI5 ! NO3I +C +CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = MAX(CHI2 - PSI2, ZERO) + CNH4NO3 = ZERO +C +C *** NH4Cl(s) calculations +C + A3 = XK6 /(R*TEMP*R*TEMP) + IF (GNH3*GHCL.GT.A3) THEN + DELT = MIN(GNH3, GHCL) + BB = -(GNH3+GHCL) + CC = GNH3*GHCL-A3 + DD = BB*BB - 4.D0*CC + PSI31 = 0.5D0*(-BB + SQRT(DD)) + PSI32 = 0.5D0*(-BB - SQRT(DD)) + IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN + PSI3 = PSI31 + ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN + PSI3 = PSI32 + ELSE + PSI3 = ZERO + ENDIF + ELSE + PSI3 = ZERO + ENDIF +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(GNH3 - PSI3, TINY) + GHCL = MAX(GHCL - PSI3, TINY) + CNH4CL = PSI3 +C +C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 IF (CHI4.LE.TINY) THEN + FUNCG2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE + ELSE + FUNCG2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE + ENDIF +C + RETURN +C +C *** END OF FUNCTION FUNCG2A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG1 +C *** CASE G1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4CL, NA2SO4 +C +C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: +C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCG1A) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG1 + INCLUDE 'isrpia.inc' + EXTERNAL CALCG1A, CALCG2A +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMG1) THEN + SCASE = 'G1 ; SUBCASE 1' + CALL CALCG1A ! SOLID PHASE ONLY POSSIBLE + SCASE = 'G1 ; SUBCASE 1' + ELSE + SCASE = 'G1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE + CALL CALCMDRH (RH, DRMG1, DRNH4NO3, CALCG1A, CALCG2A) + SCASE = 'G1 ; SUBCASE 2' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCG1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCG1A +C *** CASE G1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 +C +C SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3 +C IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF +C NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN +C THE SOLID PHASE. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCG1A + INCLUDE 'isrpia.inc' + DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2 +C +C *** CALCULATE NON VOLATILE SOLIDS *********************************** +C + CNA2SO4 = 0.5*W(1) + CNH42S4 = W(2) - CNA2SO4 +C +C *** CALCULATE VOLATILE SPECIES ************************************** +C + ALF = W(3) - 2.0*CNH42S4 + BET = W(5) + GAM = W(4) +C + RTSQ = R*TEMP*R*TEMP + A1 = XK6/RTSQ + A2 = XK10/RTSQ +C + THETA1 = GAM - BET*(A2/A1) + THETA2 = A2/A1 +C +C QUADRATIC EQUATION SOLUTION +C + BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) + CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) + DD = BB*BB - 4.0D0*CC + IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately +C +C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID +C + SQDD = SQRT(DD) + KAPA1 = 0.5D0*(-BB+SQDD) + KAPA2 = 0.5D0*(-BB-SQDD) + LAMDA1 = THETA1 + THETA2*KAPA1 + LAMDA2 = THETA1 + THETA2*KAPA2 +C + IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN + IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. + & BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN + KAPA = KAPA1 + LAMDA= LAMDA1 + GOTO 200 + ENDIF + ENDIF +C + IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN + IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. + & BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN + KAPA = KAPA2 + LAMDA= LAMDA2 + GOTO 200 + ENDIF + ENDIF +C +C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA +C +100 KAPA = ZERO + LAMDA = ZERO + DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) + DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) +C +C NH4CL EQUILIBRIUM +C + IF (DD1.GE.ZERO) THEN + SQDD1 = SQRT(DD1) + KAPA1 = 0.5D0*(ALF+BET + SQDD1) + KAPA2 = 0.5D0*(ALF+BET - SQDD1) +C + IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN + KAPA = KAPA1 + ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN + KAPA = KAPA2 + ELSE + KAPA = ZERO + ENDIF + ENDIF +C +C NH4NO3 EQUILIBRIUM +C + IF (DD2.GE.ZERO) THEN + SQDD2 = SQRT(DD2) + LAMDA1= 0.5D0*(ALF+GAM + SQDD2) + LAMDA2= 0.5D0*(ALF+GAM - SQDD2) +C + IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN + LAMDA = LAMDA1 + ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN + LAMDA = LAMDA2 + ELSE + LAMDA = ZERO + ENDIF + ENDIF +C +C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION +C + IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN + IF (BET .LT. LAMDA/THETA1) THEN + KAPA = ZERO + ELSE + LAMDA= ZERO + ENDIF + ENDIF +C +C *** CALCULATE COMPOSITION OF VOLATILE SPECIES *********************** +C +200 CONTINUE + CNH4NO3 = LAMDA + CNH4CL = KAPA +C + GNH3 = MAX(ALF - KAPA - LAMDA, ZERO) + GHNO3 = MAX(GAM - LAMDA, ZERO) + GHCL = MAX(BET - KAPA, ZERO) +C + RETURN +C +C *** END OF SUBROUTINE CALCG1A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH6 +C *** CASE H6 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH6 + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = W(2) ! CNA2SO4 + CHI2 = ZERO ! CNH42S4 + CHI3 = ZERO ! CNH4CL + FRNA = MAX (W(1)-2.D0*CHI1, ZERO) + CHI8 = MIN (FRNA, W(4)) ! CNANO3 + CHI4 = W(3) ! NH3(g) + CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) + CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL + CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCH6A (X1) + IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCH6A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCH6A (X) + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI1 = CHI1 + PSI2 = ZERO + PSI3 = ZERO + PSI7 = CHI7 + PSI8 = CHI8 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 + A7 = XK8 *(WATER/GAMA(1))**2.0 + A8 = XK9 *(WATER/GAMA(3))**2.0 + A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) + PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) + PSI5 = MAX(PSI5, TINY) +C + IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) + DD = BB*BB-4.d0*CC + PSI4 =0.5d0*(-BB - SQRT(DD)) + PSI4 = MIN(PSI4,CHI4) + ELSE + PSI4 = TINY + ENDIF +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI + MOLAL (3) = PSI4 ! NH4I + MOLAL (4) = PSI6 + PSI7 ! CLI + MOLAL (5) = PSI2 + PSI1 ! SO4I + MOLAL (6) = ZERO ! HSO4I + MOLAL (7) = PSI5 + PSI8 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNACL = MAX(CHI7 - PSI7, ZERO) + CNANO3 = MAX(CHI8 - PSI8, ZERO) + CNA2SO4 = MAX(CHI1 - PSI1, ZERO) +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCH6A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCH6A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH5 +C *** CASE H5 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH5 + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** +C + IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN + SCASE = 'H5' + CALL CALCH1A + SCASE = 'H5' + RETURN + ENDIF +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = W(2) ! CNA2SO4 + CHI2 = ZERO ! CNH42S4 + CHI3 = ZERO ! CNH4CL + FRNA = MAX (W(1)-2.D0*CHI1, ZERO) + CHI8 = MIN (FRNA, W(4)) ! CNANO3 + CHI4 = W(3) ! NH3(g) + CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) + CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL + CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCH5A (X1) + IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCH5A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : NONE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCH5A (X) + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI1 = CHI1 + PSI2 = ZERO + PSI3 = ZERO + PSI7 = CHI7 + PSI8 = CHI8 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 + A7 = XK8 *(WATER/GAMA(1))**2.0 + A8 = XK9 *(WATER/GAMA(3))**2.0 + A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) + PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) + PSI5 = MAX(PSI5, TINY) +C + IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) + DD = BB*BB-4.d0*CC + PSI4 =0.5d0*(-BB - SQRT(DD)) + PSI4 = MIN(PSI4,CHI4) + ELSE + PSI4 = TINY + ENDIF +C + IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION + AA = PSI7+PSI8 + BB = AA*AA + CC =-A1/4.D0 + CALL POLY3 (AA, BB, CC, PSI1, ISLV) + IF (ISLV.EQ.0) THEN + PSI1 = MIN (PSI1, CHI1) + ELSE + PSI1 = ZERO + ENDIF + ENDIF +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI + MOLAL (3) = PSI4 ! NH4I + MOLAL (4) = PSI6 + PSI7 ! CLI + MOLAL (5) = PSI2 + PSI1 ! SO4I + MOLAL (6) = ZERO + MOLAL (7) = PSI5 + PSI8 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNACL = MAX(CHI7 - PSI7, ZERO) + CNANO3 = MAX(CHI8 - PSI8, ZERO) + CNA2SO4 = MAX(CHI1 - PSI1, ZERO) +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCH5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCH5A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH4 +C *** CASE H4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH4 + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** +C + IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN + SCASE = 'H4' + CALL CALCH1A + SCASE = 'H4' + RETURN + ENDIF +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = W(2) ! CNA2SO4 + CHI2 = ZERO ! CNH42S4 + CHI3 = ZERO ! CNH4CL + FRNA = MAX (W(1)-2.D0*CHI1, ZERO) + CHI8 = MIN (FRNA, W(4)) ! CNANO3 + CHI4 = W(3) ! NH3(g) + CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) + CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL + CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCH4A (X1) + IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCH4A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCH4A (X) + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI1 = CHI1 + PSI2 = ZERO + PSI3 = ZERO + PSI7 = CHI7 + PSI8 = CHI8 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 + A7 = XK8 *(WATER/GAMA(1))**2.0 + A8 = XK9 *(WATER/GAMA(3))**2.0 + A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) + PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) + PSI5 = MAX(PSI5, TINY) +C + IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) + DD = BB*BB-4.d0*CC + PSI4 =0.5d0*(-BB - SQRT(DD)) + PSI4 = MIN(PSI4,CHI4) + ELSE + PSI4 = TINY + ENDIF +C + IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION + AA = PSI7+PSI8 + BB = AA*AA + CC =-A1/4.D0 + CALL POLY3 (AA, BB, CC, PSI1, ISLV) + IF (ISLV.EQ.0) THEN + PSI1 = MIN (PSI1, CHI1) + ELSE + PSI1 = ZERO + ENDIF + ENDIF +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI + MOLAL (3) = PSI4 ! NH4I + MOLAL (4) = PSI6 + PSI7 ! CLI + MOLAL (5) = PSI2 + PSI1 ! SO4I + MOLAL (6) = ZERO + MOLAL (7) = PSI5 + PSI8 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNACL = MAX(CHI7 - PSI7, ZERO) + CNANO3 = MAX(CHI8 - PSI8, ZERO) + CNA2SO4 = MAX(CHI1 - PSI1, ZERO) +C +C *** NH4Cl(s) calculations +C + A3 = XK6 /(R*TEMP*R*TEMP) + DELT = MIN(GNH3, GHCL) + BB = -(GNH3+GHCL) + CC = GNH3*GHCL-A3 + DD = BB*BB - 4.D0*CC + PSI31 = 0.5D0*(-BB + SQRT(DD)) + PSI32 = 0.5D0*(-BB - SQRT(DD)) + IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN + PSI3 = PSI31 + ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN + PSI3 = PSI32 + ELSE + PSI3 = ZERO + ENDIF +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(GNH3 - PSI3, TINY) + GHCL = MAX(GHCL - PSI3, TINY) + CNH4CL = PSI3 +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCH4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCH4A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH3 +C *** CASE H3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH3 + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** +C + IF (W(4).LE.TINY) THEN ! NO3 NOT EXIST, WATER NOT POSSIBLE + SCASE = 'H3' + CALL CALCH1A + SCASE = 'H3' + RETURN + ENDIF +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = W(2) ! CNA2SO4 + CHI2 = ZERO ! CNH42S4 + CHI3 = ZERO ! CNH4CL + FRNA = MAX (W(1)-2.D0*CHI1, ZERO) + CHI8 = MIN (FRNA, W(4)) ! CNANO3 + CHI4 = W(3) ! NH3(g) + CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) + CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL + CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCH3A (X1) + IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCH3A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCH3A (X) + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI1 = CHI1 + PSI2 = ZERO + PSI3 = ZERO + PSI7 = CHI7 + PSI8 = CHI8 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 + A7 = XK8 *(WATER/GAMA(1))**2.0 + A8 = XK9 *(WATER/GAMA(3))**2.0 + A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) + PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) + PSI5 = MAX(PSI5, TINY) +C + IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) + DD = BB*BB-4.d0*CC + PSI4 =0.5d0*(-BB - SQRT(DD)) + PSI4 = MIN(PSI4,CHI4) + ELSE + PSI4 = TINY + ENDIF +C + IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION + DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7 + PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) ) + PSI7 = MAX(MIN(PSI7, CHI7), ZERO) + ENDIF +C + IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION + AA = PSI7+PSI8 + BB = AA*AA + CC =-A1/4.D0 + CALL POLY3 (AA, BB, CC, PSI1, ISLV) + IF (ISLV.EQ.0) THEN + PSI1 = MIN (PSI1, CHI1) + ELSE + PSI1 = ZERO + ENDIF + ENDIF +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI + MOLAL (3) = PSI4 ! NH4I + MOLAL (4) = PSI6 + PSI7 ! CLI + MOLAL (5) = PSI2 + PSI1 ! SO4I + MOLAL (6) = ZERO + MOLAL (7) = PSI5 + PSI8 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNACL = MAX(CHI7 - PSI7, ZERO) + CNANO3 = MAX(CHI8 - PSI8, ZERO) + CNA2SO4 = MAX(CHI1 - PSI1, ZERO) +C +C *** NH4Cl(s) calculations +C + A3 = XK6 /(R*TEMP*R*TEMP) + DELT = MIN(GNH3, GHCL) + BB = -(GNH3+GHCL) + CC = GNH3*GHCL-A3 + DD = BB*BB - 4.D0*CC + PSI31 = 0.5D0*(-BB + SQRT(DD)) + PSI32 = 0.5D0*(-BB - SQRT(DD)) + IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN + PSI3 = PSI31 + ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN + PSI3 = PSI32 + ELSE + PSI3 = ZERO + ENDIF +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(GNH3 - PSI3, TINY) + GHCL = MAX(GHCL - PSI3, TINY) + CNH4CL = PSI3 +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCH3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCH3A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH2 +C *** CASE H2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : NH4Cl, NA2SO4, NANO3, NACL +C +C THERE ARE THREE REGIMES IN THIS CASE: +C 1. NH4NO3(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCH2A) +C 2. NH4NO3(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY +C 3. NH4NO3(s) NOT POSSIBLE, AND RH >= MDRH. (MDRH REGION) +C +C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES H1A, H2B +C RESPECTIVELY (BECAUSE MDRH POINTS COINCIDE). +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH2 + INCLUDE 'isrpia.inc' + EXTERNAL CALCH1A, CALCH3 +C +C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES *********************** +C + IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE + SCASE = 'H2 ; SUBCASE 1' + CALL CALCH2A + SCASE = 'H2 ; SUBCASE 1' + ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE + SCASE = 'H2 ; SUBCASE 1' + CALL CALCH1A + SCASE = 'H2 ; SUBCASE 1' + ENDIF +C + IF (WATER.LE.TINY .AND. RH.LT.DRMH2) THEN ! DRY AEROSOL + SCASE = 'H2 ; SUBCASE 2' +C + ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMH2) THEN ! MDRH OF H2 + SCASE = 'H2 ; SUBCASE 3' + CALL CALCMDRH (RH, DRMH2, DRNANO3, CALCH1A, CALCH3) + SCASE = 'H2 ; SUBCASE 3' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCH2 ****************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH2A +C *** CASE H2 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH2A + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. + CHI1 = W(2) ! CNA2SO4 + CHI2 = ZERO ! CNH42S4 + CHI3 = ZERO ! CNH4CL + FRNA = MAX (W(1)-2.D0*CHI1, ZERO) + CHI8 = MIN (FRNA, W(4)) ! CNANO3 + CHI4 = W(3) ! NH3(g) + CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g) + CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL + CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g) +C + PSI6LO = TINY + PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4) +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI6LO + Y1 = FUNCH2A (X1) + IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI6HI-PSI6LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1+DX + Y2 = FUNCH2A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2) 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCH2A (X) + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI6 = X + PSI1 = CHI1 + PSI2 = ZERO + PSI3 = ZERO + PSI7 = CHI7 + PSI8 = CHI8 + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK5 *(WATER/GAMA(2))**3.0 + A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0 + A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0 + A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0 + A7 = XK8 *(WATER/GAMA(1))**2.0 + A8 = XK9 *(WATER/GAMA(3))**2.0 + A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0 + A64 = A64*(R*TEMP*WATER)**2.0 + A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3) + PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7) + PSI5 = MAX(PSI5, TINY) +C + IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln + BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4) + CC = CHI4*(PSI5+PSI6) + DD = BB*BB-4.d0*CC + PSI4 =0.5d0*(-BB - SQRT(DD)) + PSI4 = MIN(PSI4,CHI4) + ELSE + PSI4 = TINY + ENDIF +C + IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION + DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7 + PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) ) + PSI7 = MAX(MIN(PSI7, CHI7), ZERO) + ENDIF +C + IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION + DIAK = (PSI7-PSI5)**2.D0 + 4.D0*A8 + PSI8 = 0.5D0*( -(PSI7+PSI5) + SQRT(DIAK) ) + PSI8 = MAX(MIN(PSI8, CHI8), ZERO) + ENDIF +C + IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION + AA = PSI7+PSI8 + BB = AA*AA + CC =-A1/4.D0 + CALL POLY3 (AA, BB, CC, PSI1, ISLV) + IF (ISLV.EQ.0) THEN + PSI1 = MIN (PSI1, CHI1) + ELSE + PSI1 = ZERO + ENDIF + ENDIF +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI + MOLAL (3) = PSI4 ! NH4I + MOLAL (4) = PSI6 + PSI7 ! CLI + MOLAL (5) = PSI2 + PSI1 ! SO4I + MOLAL (6) = ZERO ! HSO4I + MOLAL (7) = PSI5 + PSI8 ! NO3I +C + SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) + CALL CALCPH (SMIN, HI, OHI) + MOLAL (1) = HI +C + GNH3 = MAX(CHI4 - PSI4, TINY) + GHNO3 = MAX(CHI5 - PSI5, TINY) + GHCL = MAX(CHI6 - PSI6, TINY) +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNACL = MAX(CHI7 - PSI7, ZERO) + CNANO3 = MAX(CHI8 - PSI8, ZERO) + CNA2SO4 = MAX(CHI1 - PSI1, ZERO) +C +C *** NH4Cl(s) calculations +C + A3 = XK6 /(R*TEMP*R*TEMP) + DELT = MIN(GNH3, GHCL) + BB = -(GNH3+GHCL) + CC = GNH3*GHCL-A3 + DD = BB*BB - 4.D0*CC + PSI31 = 0.5D0*(-BB + SQRT(DD)) + PSI32 = 0.5D0*(-BB - SQRT(DD)) + IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN + PSI3 = PSI31 + ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN + PSI3 = PSI32 + ELSE + PSI3 = ZERO + ENDIF +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C + GNH3 = MAX(GNH3 - PSI3, TINY) + GHCL = MAX(GHCL - PSI3, TINY) + CNH4CL = PSI3 +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 FUNCH2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE +C + RETURN +C +C *** END OF FUNCTION FUNCH2A ******************************************* +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH1 +C *** CASE H1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4 +C +C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: +C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCH1A) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH1 + INCLUDE 'isrpia.inc' + EXTERNAL CALCH1A, CALCH2A +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMH1) THEN + SCASE = 'H1 ; SUBCASE 1' + CALL CALCH1A ! SOLID PHASE ONLY POSSIBLE + SCASE = 'H1 ; SUBCASE 1' + ELSE + SCASE = 'H1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE + CALL CALCMDRH (RH, DRMH1, DRNH4NO3, CALCH1A, CALCH2A) + SCASE = 'H1 ; SUBCASE 2' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCH1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCH1A +C *** CASE H1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCH1A + INCLUDE 'isrpia.inc' + DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, + & NO3FR +C +C *** CALCULATE NON VOLATILE SOLIDS *********************************** +C + CNA2SO4 = W(2) + CNH42S4 = ZERO + NAFR = MAX (W(1)-2*CNA2SO4, ZERO) + CNANO3 = MIN (NAFR, W(4)) + NO3FR = MAX (W(4)-CNANO3, ZERO) + CNACL = MIN (MAX(NAFR-CNANO3, ZERO), W(5)) + CLFR = MAX (W(5)-CNACL, ZERO) +C +C *** CALCULATE VOLATILE SPECIES ************************************** +C + ALF = W(3) ! FREE NH3 + BET = CLFR ! FREE CL + GAM = NO3FR ! FREE NO3 +C + RTSQ = R*TEMP*R*TEMP + A1 = XK6/RTSQ + A2 = XK10/RTSQ +C + THETA1 = GAM - BET*(A2/A1) + THETA2 = A2/A1 +C +C QUADRATIC EQUATION SOLUTION +C + BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2) + CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2) + DD = BB*BB - 4.0D0*CC + IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately +C +C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID +C + SQDD = SQRT(DD) + KAPA1 = 0.5D0*(-BB+SQDD) + KAPA2 = 0.5D0*(-BB-SQDD) + LAMDA1 = THETA1 + THETA2*KAPA1 + LAMDA2 = THETA1 + THETA2*KAPA2 +C + IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN + IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. + & BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN + KAPA = KAPA1 + LAMDA= LAMDA1 + GOTO 200 + ENDIF + ENDIF +C + IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN + IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. + & BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN + KAPA = KAPA2 + LAMDA= LAMDA2 + GOTO 200 + ENDIF + ENDIF +C +C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA +C +100 KAPA = ZERO + LAMDA = ZERO + DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1) + DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2) +C +C NH4CL EQUILIBRIUM +C + IF (DD1.GE.ZERO) THEN + SQDD1 = SQRT(DD1) + KAPA1 = 0.5D0*(ALF+BET + SQDD1) + KAPA2 = 0.5D0*(ALF+BET - SQDD1) +C + IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN + KAPA = KAPA1 + ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN + KAPA = KAPA2 + ELSE + KAPA = ZERO + ENDIF + ENDIF +C +C NH4NO3 EQUILIBRIUM +C + IF (DD2.GE.ZERO) THEN + SQDD2 = SQRT(DD2) + LAMDA1= 0.5D0*(ALF+GAM + SQDD2) + LAMDA2= 0.5D0*(ALF+GAM - SQDD2) +C + IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN + LAMDA = LAMDA1 + ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN + LAMDA = LAMDA2 + ELSE + LAMDA = ZERO + ENDIF + ENDIF +C +C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION +C + IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN + IF (BET .LT. LAMDA/THETA1) THEN + KAPA = ZERO + ELSE + LAMDA= ZERO + ENDIF + ENDIF +C +C *** CALCULATE COMPOSITION OF VOLATILE SPECIES *********************** +C +200 CONTINUE + CNH4NO3 = LAMDA + CNH4CL = KAPA +C + GNH3 = ALF - KAPA - LAMDA + GHNO3 = GAM - LAMDA + GHCL = BET - KAPA +C + RETURN +C +C *** END OF SUBROUTINE CALCH1A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI6 +C *** CASE I6 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI6 + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4HS4 ! Save from CALCI1 run + CHI2 = CLC + CHI3 = CNAHSO4 + CHI4 = CNA2SO4 + CHI5 = CNH42S4 +C + PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's + PSI2 = CLC + PSI3 = CNAHSO4 + PSI4 = CNA2SO4 + PSI5 = CNH42S4 +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 + CC =-A6*(PSI2 + PSI3 + PSI1) + DD = BB*BB - 4.D0*CC + PSI6 = 0.5D0*(-BB + SQRT(DD)) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (1) = PSI6 ! HI + MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI + MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I + MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I + MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I + CLC = ZERO + CNAHSO4 = ZERO + CNA2SO4 = CHI4 - PSI4 + CNH42S4 = ZERO + CNH4HS4 = ZERO + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +20 RETURN +C +C *** END OF SUBROUTINE CALCI6 ***************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI5 +C *** CASE I5 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI5 + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4HS4 ! Save from CALCI1 run + CHI2 = CLC + CHI3 = CNAHSO4 + CHI4 = CNA2SO4 + CHI5 = CNH42S4 +C + PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's + PSI2 = CLC + PSI3 = CNAHSO4 + PSI4 = ZERO + PSI5 = CNH42S4 +C + CALAOU =.TRUE. ! Outer loop activity calculation flag + PSI4LO = ZERO ! Low limit + PSI4HI = CHI4 ! High limit +C +C *** IF NA2SO4(S) =0, CALL FUNCI5B FOR Y4=0 *************************** +C + IF (CHI4.LE.TINY) THEN + Y1 = FUNCI5A (ZERO) + GOTO 50 + ENDIF +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI4HI + Y1 = FUNCI5A (X1) + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ** +C + IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1-DX + Y2 = FUNCI5A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL +C + YLO= Y1 ! Save Y-value at Hi position + IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + Y3 = FUNCI5A (ZERO) + GOTO 50 + ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + GOTO 50 + ELSE + CALL PUSHERR (0001, 'CALCI5') ! WARNING ERROR: NO SOLUTION + GOTO 50 + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCI5A (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCI5') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCI5A (X3) +C +50 RETURN + +C *** END OF SUBROUTINE CALCI5 ***************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE FUNCI5A +C *** CASE I5 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCI5A (P4) + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI4 = P4 ! PSI3 already assigned in FUNCI5A + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A4 = XK5 *(WATER/GAMA(2))**3.0 + A5 = XK7 *(WATER/GAMA(4))**3.0 + A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. +C +C CALCULATE DISSOCIATION QUANTITIES +C + BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 + CC =-A6*(PSI2 + PSI3 + PSI1) + DD = BB*BB - 4.D0*CC + PSI6 = 0.5D0*(-BB + SQRT(DD)) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (1) = PSI6 ! HI + MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI + MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I + MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I + MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I + CLC = ZERO + CNAHSO4 = ZERO + CNA2SO4 = CHI4 - PSI4 + CNH42S4 = ZERO + CNH4HS4 = ZERO + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 A4 = XK5 *(WATER/GAMA(2))**3.0 + FUNCI5A= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE + RETURN +C +C *** END OF FUNCTION FUNCI5A ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI4 +C *** CASE I4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI4 + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4HS4 ! Save from CALCI1 run + CHI2 = CLC + CHI3 = CNAHSO4 + CHI4 = CNA2SO4 + CHI5 = CNH42S4 +C + PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's + PSI2 = CLC + PSI3 = CNAHSO4 + PSI4 = ZERO + PSI5 = ZERO +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + PSI4LO = ZERO ! Low limit + PSI4HI = CHI4 ! High limit +C +C *** IF NA2SO4(S) =0, CALL FUNCI4B FOR Y4=0 *************************** +C + IF (CHI4.LE.TINY) THEN + Y1 = FUNCI4A (ZERO) + GOTO 50 + ENDIF +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI4HI + Y1 = FUNCI4A (X1) + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ** +C + IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1-DX + Y2 = FUNCI4A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL +C + YLO= Y1 ! Save Y-value at Hi position + IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + Y3 = FUNCI4A (ZERO) + GOTO 50 + ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + GOTO 50 + ELSE + CALL PUSHERR (0001, 'CALCI4') ! WARNING ERROR: NO SOLUTION + GOTO 50 + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCI4A (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCI4') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCI4A (X3) +C +50 RETURN + +C *** END OF SUBROUTINE CALCI4 ***************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE FUNCI4A +C *** CASE I4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCI4A (P4) + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI4 = P4 ! PSI3 already assigned in FUNCI4A + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A4 = XK5 *(WATER/GAMA(2))**3.0 + A5 = XK7 *(WATER/GAMA(4))**3.0 + A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + A7 = SQRT(A4/A5) +C +C CALCULATE DISSOCIATION QUANTITIES +C + BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 + CC =-A6*(PSI2 + PSI3 + PSI1) + DD = BB*BB - 4.D0*CC + PSI6 = 0.5D0*(-BB + SQRT(DD)) +C + PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7 + PSI5 = MIN (PSI5, CHI5) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (1) = PSI6 ! HI + MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI + MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I + MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I + MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I + CLC = ZERO + CNAHSO4 = ZERO + CNA2SO4 = CHI4 - PSI4 + CNH42S4 = CHI5 - PSI5 + CNH4HS4 = ZERO + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 A4 = XK5 *(WATER/GAMA(2))**3.0 + FUNCI4A= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE + RETURN +C +C *** END OF FUNCTION FUNCI4A ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI3 +C *** CASE I3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC +C +C THERE ARE THREE REGIMES IN THIS CASE: +C 1.(NA,NH4)HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI3A) +C 2.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY +C 3.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL +C +C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B +C RESPECTIVELY +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI3 + INCLUDE 'isrpia.inc' + EXTERNAL CALCI1A, CALCI4 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A +C +C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** +C + IF (CNH4HS4.GT.TINY .OR. CNAHSO4.GT.TINY) THEN + SCASE = 'I3 ; SUBCASE 1' + CALL CALCI3A ! FULL SOLUTION + SCASE = 'I3 ; SUBCASE 1' + ENDIF +C + IF (WATER.LE.TINY) THEN + IF (RH.LT.DRMI3) THEN ! SOLID SOLUTION + WATER = TINY + DO 10 I=1,NIONS + MOLAL(I) = ZERO +10 CONTINUE + CALL CALCI1A + SCASE = 'I3 ; SUBCASE 2' +C + ELSEIF (RH.GE.DRMI3) THEN ! MDRH OF I3 + SCASE = 'I3 ; SUBCASE 3' + CALL CALCMDRH (RH, DRMI3, DRLC, CALCI1A, CALCI4) + SCASE = 'I3 ; SUBCASE 3' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCI3 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI3A +C *** CASE I3 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI3A + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A ! Needed when called from CALCMDRH +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4HS4 ! Save from CALCI1 run + CHI2 = CLC + CHI3 = CNAHSO4 + CHI4 = CNA2SO4 + CHI5 = CNH42S4 +C + PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's + PSI2 = ZERO + PSI3 = CNAHSO4 + PSI4 = ZERO + PSI5 = ZERO +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + PSI2LO = ZERO ! Low limit + PSI2HI = CHI2 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI2HI + Y1 = FUNCI3A (X1) + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC ********* +C + IF (YHI.LT.EPS) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI2HI-PSI2LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = MAX(X1-DX, PSI2LO) + Y2 = FUNCI3A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC +C + IF (Y2.GT.EPS) Y2 = FUNCI3A (ZERO) + GOTO 50 +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCI3A (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCI3A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCI3A (X3) +C +50 RETURN + +C *** END OF SUBROUTINE CALCI3A ***************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE FUNCI3A +C *** CASE I3 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCI3A (P2) + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI2 = P2 ! Save PSI2 in COMMON BLOCK + PSI4LO = ZERO ! Low limit for PSI4 + PSI4HI = CHI4 ! High limit for PSI4 +C +C *** IF NH3 =0, CALL FUNCI3B FOR Y4=0 ******************************** +C + IF (CHI4.LE.TINY) THEN + FUNCI3A = FUNCI3B (ZERO) + GOTO 50 + ENDIF +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI4HI + Y1 = FUNCI3B (X1) + IF (ABS(Y1).LE.EPS) GOTO 50 + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 ***** +C + IF (YHI.LT.ZERO) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI4HI-PSI4LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = MAX(X1-DX, PSI4LO) + Y2 = FUNCI3B (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 +C + IF (Y2.GT.EPS) Y2 = FUNCI3B (PSI4LO) + GOTO 50 +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCI3B (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0004, 'FUNCI3A') ! WARNING ERROR: NO CONVERGENCE +C +C *** INNER LOOP CONVERGED ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCI3B (X3) +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +50 A2 = XK13*(WATER/GAMA(13))**5.0 + FUNCI3A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE + RETURN +C +C *** END OF FUNCTION FUNCI3A ******************************************* +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCI3B +C *** CASE I3 ; SUBCASE 2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC +C +C SOLUTION IS SAVED IN COMMON BLOCK /CASE/ +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCI3B (P4) + INCLUDE 'isrpia.inc' +C + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + PSI4 = P4 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A4 = XK5*(WATER/GAMA(2))**3.0 + A5 = XK7*(WATER/GAMA(4))**3.0 + A6 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + A7 = SQRT(A4/A5) +C +C CALCULATE DISSOCIATION QUANTITIES +C + BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 + CC =-A6*(PSI2 + PSI3 + PSI1) + DD = BB*BB - 4.D0*CC + PSI6 = 0.5D0*(-BB + SQRT(DD)) +C + PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7 + PSI5 = MIN (PSI5, CHI5) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL(1) = PSI6 ! HI + MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI + MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I + MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I + MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 - PSI6, TINY) ! HSO4I + CLC = MAX(CHI2 - PSI2, ZERO) + CNAHSO4 = ZERO + CNA2SO4 = MAX(CHI4 - PSI4, ZERO) + CNH42S4 = MAX(CHI5 - PSI5, ZERO) + CNH4HS4 = ZERO + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 A4 = XK5 *(WATER/GAMA(2))**3.0 + FUNCI3B= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE + RETURN +C +C *** END OF FUNCTION FUNCI3B ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI2 +C *** CASE I2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC +C +C THERE ARE THREE REGIMES IN THIS CASE: +C 1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI2A) +C 2. NH4HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY +C 3. NH4HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL +C +C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B +C RESPECTIVELY +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI2 + INCLUDE 'isrpia.inc' + EXTERNAL CALCI1A, CALCI3A +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A +C +C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH ********************** +C + IF (CNH4HS4.GT.TINY) THEN + SCASE = 'I2 ; SUBCASE 1' + CALL CALCI2A + SCASE = 'I2 ; SUBCASE 1' + ENDIF +C + IF (WATER.LE.TINY) THEN + IF (RH.LT.DRMI2) THEN ! SOLID SOLUTION ONLY + WATER = TINY + DO 10 I=1,NIONS + MOLAL(I) = ZERO +10 CONTINUE + CALL CALCI1A + SCASE = 'I2 ; SUBCASE 2' +C + ELSEIF (RH.GE.DRMI2) THEN ! MDRH OF I2 + SCASE = 'I2 ; SUBCASE 3' + CALL CALCMDRH (RH, DRMI2, DRNAHSO4, CALCI1A, CALCI3A) + SCASE = 'I2 ; SUBCASE 3' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCI2 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI2A +C *** CASE I2 ; SUBCASE A +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI2A + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** FIND DRY COMPOSITION ********************************************** +C + CALL CALCI1A ! Needed when called from CALCMDRH +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = CNH4HS4 ! Save from CALCI1 run + CHI2 = CLC + CHI3 = CNAHSO4 + CHI4 = CNA2SO4 + CHI5 = CNH42S4 +C + PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's + PSI2 = ZERO + PSI3 = ZERO + PSI4 = ZERO + PSI5 = ZERO +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + PSI2LO = ZERO ! Low limit + PSI2HI = CHI2 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI2HI + Y1 = FUNCI2A (X1) + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC ********* +C + IF (YHI.LT.EPS) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI2HI-PSI2LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = MAX(X1-DX, PSI2LO) + Y2 = FUNCI2A (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC +C + IF (Y2.GT.EPS) Y2 = FUNCI3A (ZERO) + GOTO 50 +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCI2A (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCI2A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCI2A (X3) +C +50 RETURN + +C *** END OF SUBROUTINE CALCI2A ***************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE FUNCI2A +C *** CASE I2 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCI2A (P2) + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. + PSI2 = P2 ! Save PSI2 in COMMON BLOCK + PSI3 = CHI3 + PSI4 = CHI4 + PSI5 = CHI5 + PSI6 = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A3 = XK11*(WATER/GAMA(12))**2.0 + A4 = XK5 *(WATER/GAMA(2))**3.0 + A5 = XK7 *(WATER/GAMA(4))**3.0 + A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2. + A7 = SQRT(A4/A5) +C +C CALCULATE DISSOCIATION QUANTITIES +C + IF (CHI5.GT.TINY .AND. WATER.GT.TINY) THEN + PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7 + PSI5 = MAX(MIN (PSI5, CHI5), TINY) + ENDIF +C + IF (CHI4.GT.TINY .AND. WATER.GT.TINY) THEN + AA = PSI2+PSI5+PSI6+PSI3 + BB = PSI3*AA + CC = 0.25D0*(PSI3*PSI3*(PSI2+PSI5+PSI6)-A4) + CALL POLY3 (AA, BB, CC, PSI4, ISLV) + IF (ISLV.EQ.0) THEN + PSI4 = MIN (PSI4, CHI4) + ELSE + PSI4 = ZERO + ENDIF + ENDIF +C + IF (CHI3.GT.TINY .AND. WATER.GT.TINY) THEN + AA = 2.D0*PSI4 + PSI2 + PSI1 - PSI6 + BB = 2.D0*PSI4*(PSI2 + PSI1 - PSI6) - A3 + CC = ZERO + CALL POLY3 (AA, BB, CC, PSI3, ISLV) + IF (ISLV.EQ.0) THEN + PSI3 = MIN (PSI3, CHI3) + ELSE + PSI3 = ZERO + ENDIF + ENDIF +C + BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6 + CC =-A6*(PSI2 + PSI3 + PSI1) + DD = BB*BB - 4.D0*CC + PSI6 = 0.5D0*(-BB + SQRT(DD)) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (1) = PSI6 ! HI + MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI + MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I + MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I + MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I + CLC = CHI2 - PSI2 + CNAHSO4 = CHI3 - PSI3 + CNA2SO4 = CHI4 - PSI4 + CNH42S4 = CHI5 - PSI5 + CNH4HS4 = ZERO + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP *************************** +C +20 A2 = XK13*(WATER/GAMA(13))**5.0 + FUNCI2A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE + RETURN +C +C *** END OF FUNCTION FUNCI2A ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI1 +C *** CASE I1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4 +C +C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY: +C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCI1A) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI1 + INCLUDE 'isrpia.inc' + EXTERNAL CALCI1A, CALCI2A +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMI1) THEN + SCASE = 'I1 ; SUBCASE 1' + CALL CALCI1A ! SOLID PHASE ONLY POSSIBLE + SCASE = 'I1 ; SUBCASE 1' + ELSE + SCASE = 'I1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE + CALL CALCMDRH (RH, DRMI1, DRNH4HS4, CALCI1A, CALCI2A) + SCASE = 'I1 ; SUBCASE 2' + ENDIF +C +C *** AMMONIA IN GAS PHASE ********************************************** +C +C CALL CALCNH3 +C + RETURN +C +C *** END OF SUBROUTINE CALCI1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCI1A +C *** CASE I1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCI1A + INCLUDE 'isrpia.inc' +C +C *** CALCULATE NON VOLATILE SOLIDS *********************************** +C + CNA2SO4 = 0.5D0*W(1) + CNH4HS4 = ZERO + CNAHSO4 = ZERO + CNH42S4 = ZERO + FRSO4 = MAX(W(2)-CNA2SO4, ZERO) +C + CLC = MIN(W(3)/3.D0, FRSO4/2.D0) + FRSO4 = MAX(FRSO4-2.D0*CLC, ZERO) + FRNH4 = MAX(W(3)-3.D0*CLC, ZERO) +C + IF (FRSO4.LE.TINY) THEN + CLC = MAX(CLC - FRNH4, ZERO) + CNH42S4 = 2.D0*FRNH4 + + ELSEIF (FRNH4.LE.TINY) THEN + CNH4HS4 = 3.D0*MIN(FRSO4, CLC) + CLC = MAX(CLC-FRSO4, ZERO) + IF (CNA2SO4.GT.TINY) THEN + FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO) + CNAHSO4 = 2.D0*FRSO4 + CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO) + ENDIF + ENDIF +C +C *** CALCULATE GAS SPECIES ********************************************* +C + GHNO3 = W(4) + GHCL = W(5) + GNH3 = ZERO +C + RETURN +C +C *** END OF SUBROUTINE CALCI1A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCJ3 +C *** CASE J3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS ONLY A LIQUID PHASE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCJ3 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA, KAPA +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + FRST = .TRUE. + CALAIN = .TRUE. +C + LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4 + CHI1 = W(1) ! NA TOTAL as NaHSO4 + CHI2 = W(3) ! NH4 TOTAL as NH4HSO4 + PSI1 = CHI1 + PSI2 = CHI2 ! ALL NH4HSO4 DELIQUESCED +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 +C +C CALCULATE DISSOCIATION QUANTITIES +C + BB = A3+LAMDA ! KAPA + CC =-A3*(LAMDA + PSI1 + PSI2) + DD = BB*BB-4.D0*CC + KAPA = 0.5D0*(-BB+SQRT(DD)) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (1) = LAMDA + KAPA ! HI + MOLAL (2) = PSI1 ! NAI + MOLAL (3) = PSI2 ! NH4I + MOLAL (4) = ZERO ! CLI + MOLAL (5) = KAPA ! SO4I + MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I + MOLAL (7) = ZERO ! NO3I +C + CNAHSO4 = ZERO + CNH4HS4 = ZERO +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 50 + ENDIF +10 CONTINUE +C +50 RETURN +C +C *** END OF SUBROUTINE CALCJ3 ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCJ2 +C *** CASE J2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : NAHSO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCJ2 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA, KAPA + COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, + & A1, A2, A3 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + CHI1 = W(1) ! NA TOTAL + CHI2 = W(3) ! NH4 TOTAL + PSI1LO = TINY ! Low limit + PSI1HI = CHI1 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI1HI + Y1 = FUNCJ2 (X1) + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 **** +C + IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI1HI-PSI1LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1-DX + Y2 = FUNCJ2 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4 +C + YLO= Y1 ! Save Y-value at Hi position + IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + Y3 = FUNCJ2 (ZERO) + GOTO 50 + ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + GOTO 50 + ELSE + CALL PUSHERR (0001, 'CALCJ2') ! WARNING ERROR: NO SOLUTION + GOTO 50 + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCJ2 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCJ2') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCJ2 (X3) +C +50 RETURN +C +C *** END OF SUBROUTINE CALCJ2 ****************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE FUNCJ2 +C *** CASE J2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCJ2 (P1) + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA, KAPA + COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, + & A1, A2, A3 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. +C + LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4 + PSI1 = P1 + PSI2 = CHI2 ! ALL NH4HSO4 DELIQUESCED +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK11 *(WATER/GAMA(12))**2.0 + A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 +C +C CALCULATE DISSOCIATION QUANTITIES +C + BB = A3+LAMDA ! KAPA + CC =-A3*(LAMDA + PSI1 + PSI2) + DD = BB*BB-4.D0*CC + KAPA = 0.5D0*(-BB+SQRT(DD)) +C +C *** CALCULATE SPECIATION ******************************************** +C + MOLAL (1) = LAMDA + KAPA ! HI + MOLAL (2) = PSI1 ! NAI + MOLAL (3) = PSI2 ! NH4I + MOLAL (4) = ZERO ! CLI + MOLAL (5) = KAPA ! SO4I + MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I + MOLAL (7) = ZERO ! NO3I +C + CNAHSO4 = MAX(CHI1-PSI1,ZERO) + CNH4HS4 = ZERO +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 FUNCJ2 = MOLAL(2)*MOLAL(6)/A1 - ONE +C +C *** END OF FUNCTION FUNCJ2 ******************************************* +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCJ1 +C *** CASE J1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + SUBROUTINE CALCJ1 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION LAMDA, KAPA + COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, + & A1, A2, A3 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU =.TRUE. ! Outer loop activity calculation flag + CHI1 = W(1) ! Total NA initially as NaHSO4 + CHI2 = W(3) ! Total NH4 initially as NH4HSO4 +C + PSI1LO = TINY ! Low limit + PSI1HI = CHI1 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI1HI + Y1 = FUNCJ1 (X1) + YHI= Y1 ! Save Y-value at HI position +C +C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 **** +C + IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50 +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI1HI-PSI1LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = X1-DX + Y2 = FUNCJ1 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4 +C + YLO= Y1 ! Save Y-value at Hi position + IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + Y3 = FUNCJ1 (ZERO) + GOTO 50 + ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + GOTO 50 + ELSE + CALL PUSHERR (0001, 'CALCJ1') ! WARNING ERROR: NO SOLUTION + GOTO 50 + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCJ1 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCJ1') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCJ1 (X3) +C +50 RETURN +C +C *** END OF SUBROUTINE CALCJ1 ****************************************** +C + END + + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE FUNCJ1 +C *** CASE J1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCJ1 (P1) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION LAMDA, KAPA + COMMON /CASEJ/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, + & A1, A2, A3 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. +C + LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4 + PSI1 = P1 +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +C + A1 = XK11 *(WATER/GAMA(12))**2.0 + A2 = XK12 *(WATER/GAMA(09))**2.0 + A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0 +C + PSI2 = 0.5*(-(LAMDA+PSI1) + SQRT((LAMDA+PSI1)**2.D0+4.D0*A2)) ! PSI2 + PSI2 = MIN (PSI2, CHI2) +C + BB = A3+LAMDA ! KAPA + CC =-A3*(LAMDA + PSI2 + PSI1) + DD = BB*BB-4.D0*CC + KAPA = 0.5D0*(-BB+SQRT(DD)) +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL (1) = LAMDA + KAPA ! HI + MOLAL (2) = PSI1 ! NAI + MOLAL (3) = PSI2 ! NH4I + MOLAL (4) = ZERO + MOLAL (5) = KAPA ! SO4I + MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I + MOLAL (7) = ZERO +C + CNAHSO4 = MAX(CHI1-PSI1,ZERO) + CNH4HS4 = MAX(CHI2-PSI2,ZERO) +C + CALL CALCMR ! Water content +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 FUNCJ1 = MOLAL(2)*MOLAL(6)/A1 - ONE +C +C *** END OF FUNCTION FUNCJ1 ******************************************* +C + END + diff --git a/models/CCTM/aero/blank/isorev.f b/models/CCTM/aero/blank/isorev.f new file mode 100755 index 0000000..458ebfe --- /dev/null +++ b/models/CCTM/aero/blank/isorev.f @@ -0,0 +1,3560 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/isorev.f,v 1.2 2011/10/21 16:10:05 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C This is ISORROPIA Version 1.7 (3/15/06). More information is available +C at the ISORROPIA homepage: http://nenes.eas.gatech.edu/ISORROPIA/ +C +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRP1R +C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF +C AN AMMONIUM-SULFATE AEROSOL SYSTEM. +C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY +C THE AMBIENT RELATIVE HUMIDITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE ISRP1R (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) +C +C *** INITIALIZE COMMON BLOCK VARIABLES ********************************* +C + CALL INIT1 (WI, RHI, TEMPI) +C +C *** CALCULATE SULFATE RATIO ******************************************* +C + IF (RH.GE.DRNH42S4) THEN ! WET AEROSOL, NEED NH4 AT SRATIO=2.0 + SULRATW = GETASR(WAER(2), RHI) ! AEROSOL SULFATE RATIO + ELSE + SULRATW = 2.0D0 ! DRY AEROSOL SULFATE RATIO + ENDIF + SULRAT = WAER(3)/WAER(2) ! SULFATE RATIO +C +C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** +C +C *** SULFATE POOR +C + IF (SULRATW.LE.SULRAT) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'K2' + CALL CALCK2 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH42S4) THEN + SCASE = 'K1' + CALL CALCK1 ! NH42SO4 ; case K1 +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'K2' + CALL CALCK2 ! Only liquid ; case K2 + ENDIF + ENDIF +C +C *** SULFATE RICH (NO ACID) +C + ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.SULRATW) THEN + W(2) = WAER(2) + W(3) = WAER(3) +C + IF(METSTBL.EQ.1) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid (metastable) + SCASE = 'L4' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'B1' + CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case B1 + SCASE = 'L1' +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN + SCASE = 'B2' + CALL CALCB2 ! LC,NH42S4 ; case B2 + SCASE = 'L2' +C + ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'B3' + CALL CALCB3 ! NH42S4 ; case B3 + SCASE = 'L3' +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid ; case B4 + SCASE = 'L4' + ENDIF + ENDIF +C + CALL CALCNH3P ! Compute NH3(g) +C +C *** SULFATE RICH (FREE ACID) +C + ELSEIF (SULRAT.LT.1.0) THEN + W(2) = WAER(2) + W(3) = WAER(3) +C + IF(METSTBL.EQ.1) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid (metastable) + SCASE = 'M2' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'C1' + CALL CALCC1 ! NH4HSO4 ; case C1 + SCASE = 'M1' +C + ELSEIF (DRNH4HS4.LE.RH) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid ; case C2 + SCASE = 'M2' + ENDIF + ENDIF +C + CALL CALCNH3P +C + ENDIF + RETURN +C +C *** END OF SUBROUTINE ISRP1R ***************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRP2R +C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF +C AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM. +C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY +C THE AMBIENT RELATIVE HUMIDITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE ISRP2R (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) + LOGICAL TRYLIQ +C +C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK ************************** +C + TRYLIQ = .TRUE. ! Assume liquid phase, sulfate poor limit +C +10 CALL INIT2 (WI, RHI, TEMPI) +C +C *** CALCULATE SULFATE RATIO ******************************************* +C + IF (TRYLIQ .AND. RH.GE.DRNH4NO3) THEN ! *** WET AEROSOL + SULRATW = GETASR(WAER(2), RHI) ! LIMITING SULFATE RATIO + ELSE + SULRATW = 2.0D0 ! *** DRY AEROSOL + ENDIF + SULRAT = WAER(3)/WAER(2) +C +C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** +C +C *** SULFATE POOR +C + IF (SULRATW.LE.SULRAT) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'N3' + CALL CALCN3 ! Only liquid (metastable) + ELSE +C + IF (RH.LT.DRNH4NO3) THEN + SCASE = 'N1' + CALL CALCN1 ! NH42SO4,NH4NO3 ; case N1 +C + ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'N2' + CALL CALCN2 ! NH42S4 ; case N2 +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'N3' + CALL CALCN3 ! Only liquid ; case N3 + ENDIF + ENDIF +C +C *** SULFATE RICH (NO ACID) +C +C FOR SOLVING THIS CASE, NITRIC ACID AND AMMONIA IN THE GAS PHASE ARE +C ASSUMED A MINOR SPECIES, THAT DO NOT SIGNIFICANTLY AFFECT THE +C AEROSOL EQUILIBRIUM. +C + ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.SULRATW) THEN + W(2) = WAER(2) + W(3) = WAER(3) + W(4) = WAER(4) +C + IF(METSTBL.EQ.1) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid (metastable) + SCASE = 'O4' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'B1' + CALL CALCB1 ! NH4HSO4,LC,NH42SO4 ; case O1 + SCASE = 'O1' +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN + SCASE = 'B2' + CALL CALCB2 ! LC,NH42S4 ; case O2 + SCASE = 'O2' +C + ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'B3' + CALL CALCB3 ! NH42S4 ; case O3 + SCASE = 'O3' +C + ELSEIF (DRNH42S4.LE.RH) THEN + SCASE = 'B4' + CALL CALCB4 ! Only liquid ; case O4 + SCASE = 'O4' + ENDIF + ENDIF +C +C *** Add the NO3 to the solution now and calculate partitioning. +C + MOLAL(7) = WAER(4) ! There is always water, so NO3(aer) is NO3- + MOLAL(1) = MOLAL(1) + WAER(4) ! Add H+ to balance out + CALL CALCNAP ! HNO3, NH3 dissolved + CALL CALCNH3P +C +C *** SULFATE RICH (FREE ACID) +C +C FOR SOLVING THIS CASE, NITRIC ACID AND AMMONIA IN THE GAS PHASE ARE +C ASSUMED A MINOR SPECIES, THAT DO NOT SIGNIFICANTLY AFFECT THE +C AEROSOL EQUILIBRIUM. +C + ELSEIF (SULRAT.LT.1.0) THEN + W(2) = WAER(2) + W(3) = WAER(3) + W(4) = WAER(4) +C + IF(METSTBL.EQ.1) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid (metastable) + SCASE = 'P2' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'C1' + CALL CALCC1 ! NH4HSO4 ; case P1 + SCASE = 'P1' +C + ELSEIF (DRNH4HS4.LE.RH) THEN + SCASE = 'C2' + CALL CALCC2 ! Only liquid ; case P2 + SCASE = 'P2' + ENDIF + ENDIF +C +C *** Add the NO3 to the solution now and calculate partitioning. +C + MOLAL(7) = WAER(4) ! There is always water, so NO3(aer) is NO3- + MOLAL(1) = MOLAL(1) + WAER(4) ! Add H+ to balance out +C + CALL CALCNAP ! HNO3, NH3 dissolved + CALL CALCNH3P + ENDIF +C +C *** IF SULRATW < SULRAT < 2.0 and WATER = 0 => SULFATE RICH CASE. +C + IF (SULRATW.LE.SULRAT .AND. SULRAT.LT.2.0 + & .AND. WATER.LE.TINY) THEN + TRYLIQ = .FALSE. + GOTO 10 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE ISRP2R ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE ISRP3R +C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF +C AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM. +C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM +C RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE ISRP3R (WI, RHI, TEMPI) + INCLUDE 'isrpia.inc' + DIMENSION WI(NCOMP) + LOGICAL TRYLIQ +ccC +ccC *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE *********************** +ccC +cc WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3 +cc WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3 +C +C *** INITIALIZE ALL VARIABLES ****************************************** +C + TRYLIQ = .TRUE. ! Use liquid phase sulfate poor limit +C +10 CALL ISOINIT3 (WI, RHI, TEMPI) ! COMMON block variables +ccC +ccC *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE ********* +ccC +cc REST = 2.D0*WAER(2) + WAER(4) + WAER(5) +cc IF (WAER(1).GT.REST) THEN ! NA > 2*SO4+CL+NO3 ? +cc WAER(1) = (ONE-1D-6)*REST ! Adjust Na amount +cc CALL PUSHERR (0050, 'ISRP3R') ! Warning error: Na adjusted +cc ENDIF +C +C *** CALCULATE SULFATE & SODIUM RATIOS ********************************* +C + IF (TRYLIQ .AND. RH.GE.DRNH4NO3) THEN ! ** WET AEROSOL + FRSO4 = WAER(2) - WAER(1)/2.0D0 ! SULFATE UNBOUND BY SODIUM + FRSO4 = MAX(FRSO4, TINY) + SRI = GETASR(FRSO4, RHI) ! SULFATE RATIO FOR NH4+ + SULRATW = (WAER(1)+FRSO4*SRI)/WAER(2) ! LIMITING SULFATE RATIO + SULRATW = MIN (SULRATW, 2.0D0) + ELSE + SULRATW = 2.0D0 ! ** DRY AEROSOL + ENDIF + SULRAT = (WAER(1)+WAER(3))/WAER(2) + SODRAT = WAER(1)/WAER(2) +C +C *** FIND CALCULATION REGIME FROM (SULRAT,RH) ************************** +C +C *** SULFATE POOR ; SODIUM POOR +C + IF (SULRATW.LE.SULRAT .AND. SODRAT.LT.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'Q5' + CALL CALCQ5 ! Only liquid (metastable) + SCASE = 'Q5' + ELSE +C + IF (RH.LT.DRNH4NO3) THEN + SCASE = 'Q1' + CALL CALCQ1 ! NH42SO4,NH4NO3,NH4CL,NA2SO4 +C + ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN + SCASE = 'Q2' + CALL CALCQ2 ! NH42SO4,NH4CL,NA2SO4 +C + ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'Q3' + CALL CALCQ3 ! NH42SO4,NA2SO4 +C + ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN + SCASE = 'Q4' + CALL CALCQ4 ! NA2SO4 + SCASE = 'Q4' +C + ELSEIF (DRNA2SO4.LE.RH) THEN + SCASE = 'Q5' + CALL CALCQ5 ! Only liquid + SCASE = 'Q5' + ENDIF + ENDIF +C +C *** SULFATE POOR ; SODIUM RICH +C + ELSE IF (SULRAT.GE.SULRATW .AND. SODRAT.GE.2.0) THEN +C + IF(METSTBL.EQ.1) THEN + SCASE = 'R6' + CALL CALCR6 ! Only liquid (metastable) + SCASE = 'R6' + ELSE +C + IF (RH.LT.DRNH4NO3) THEN + SCASE = 'R1' + CALL CALCR1 ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3 +C + ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN + SCASE = 'R2' + CALL CALCR2 ! NH4CL,NA2SO4,NACL,NANO3 +C + ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN + SCASE = 'R3' + CALL CALCR3 ! NH4CL,NA2SO4,NACL +C + ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4CL) THEN + SCASE = 'R4' + CALL CALCR4 ! NH4CL,NA2SO4 +C + ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNA2SO4) THEN + SCASE = 'R5' + CALL CALCR5 ! NA2SO4 + SCASE = 'R5' +C + ELSEIF (DRNA2SO4.LE.RH) THEN + SCASE = 'R6' + CALL CALCR6 ! NO SOLID + SCASE = 'R6' + ENDIF + ENDIF +C +C *** SULFATE RICH (NO ACID) +C + ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.SULRATW) THEN + DO 100 I=1,NCOMP + W(I) = WAER(I) +100 CONTINUE +C + IF(METSTBL.EQ.1) THEN + SCASE = 'I6' + CALL CALCI6 ! Only liquid (metastable) + SCASE = 'S6' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'I1' + CALL CALCI1 ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC + SCASE = 'S1' +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN + SCASE = 'I2' + CALL CALCI2 ! NA2SO4,(NH4)2SO4,NAHSO4,LC + SCASE = 'S2' +C + ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN + SCASE = 'I3' + CALL CALCI3 ! NA2SO4,(NH4)2SO4,LC + SCASE = 'S3' +C + ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN + SCASE = 'I4' + CALL CALCI4 ! NA2SO4,(NH4)2SO4 + SCASE = 'S4' +C + ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN + SCASE = 'I5' + CALL CALCI5 ! NA2SO4 + SCASE = 'S5' +C + ELSEIF (DRNA2SO4.LE.RH) THEN + SCASE = 'I6' + CALL CALCI6 ! NO SOLIDS + SCASE = 'S6' + ENDIF + ENDIF +C + CALL CALCNHP ! HNO3, NH3, HCL in gas phase + CALL CALCNH3P +C +C *** SULFATE RICH (FREE ACID) +C + ELSEIF (SULRAT.LT.1.0) THEN + DO 200 I=1,NCOMP + W(I) = WAER(I) +200 CONTINUE +C + IF(METSTBL.EQ.1) THEN + SCASE = 'J3' + CALL CALCJ3 ! Only liquid (metastable) + SCASE = 'T3' + ELSE +C + IF (RH.LT.DRNH4HS4) THEN + SCASE = 'J1' + CALL CALCJ1 ! NH4HSO4,NAHSO4 + SCASE = 'T1' +C + ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN + SCASE = 'J2' + CALL CALCJ2 ! NAHSO4 + SCASE = 'T2' +C + ELSEIF (DRNAHSO4.LE.RH) THEN + SCASE = 'J3' + CALL CALCJ3 + SCASE = 'T3' + ENDIF + ENDIF +C + CALL CALCNHP ! HNO3, NH3, HCL in gas phase + CALL CALCNH3P +C + ENDIF +C +C *** IF AFTER CALCULATIONS, SULRATW < SULRAT < 2.0 +C and WATER = 0 => SULFATE RICH CASE. +C + IF (SULRATW.LE.SULRAT .AND. SULRAT.LT.2.0 + & .AND. WATER.LE.TINY) THEN + TRYLIQ = .FALSE. + GOTO 10 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE ISRP3R ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCK2 +C *** CASE K2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. LIQUID AEROSOL PHASE ONLY POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCK2 + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NH4I, NH3GI, NH3AQ +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU =.TRUE. ! Outer loop activity calculation flag + FRST =.TRUE. + CALAIN =.TRUE. +C +C *** CALCULATE WATER CONTENT ***************************************** +C + MOLALR(4)= MIN(WAER(2), 0.5d0*WAER(3)) + WATER = MOLALR(4)/M0(4) ! ZSR correlation +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP +CC A21 = XK21*WATER*R*TEMP + A2 = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2. + AKW = XKW *RH*WATER*WATER +C + NH4I = WAER(3) + SO4I = WAER(2) + HSO4I= ZERO +C + CALL CALCPH (2.D0*SO4I - NH4I, HI, OHI) ! Get pH +C + NH3AQ = ZERO ! AMMONIA EQUILIBRIUM + IF (HI.LT.OHI) THEN + CALL CALCAMAQ (NH4I, OHI, DEL) + NH4I = MAX (NH4I-DEL, ZERO) + OHI = MAX (OHI -DEL, TINY) + NH3AQ = DEL + HI = AKW/OHI + ENDIF +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) ! SULFATE EQUILIBRIUM + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL +C + NH3GI = NH4I/HI/A2 ! NH3AQ/A21 +C +C *** SPECIATION & WATER CONTENT *************************************** +C + MOLAL(1) = HI + MOLAL(3) = NH4I + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + COH = OHI + GASAQ(1) = NH3AQ + GNH3 = NH3GI +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +20 RETURN +C +C *** END OF SUBROUTINE CALCK2 **************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCK1 +C *** CASE K1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4 +C +C A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4 +C IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN +C THE GAS PHASE. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCK1 + INCLUDE 'isrpia.inc' +C + CNH42S4 = MIN(WAER(2),0.5d0*WAER(3)) ! For bad input problems + GNH3 = ZERO +C + W(2) = CNH42S4 + W(3) = 2.D0*CNH42S4 + GNH3 +C + RETURN +C +C *** END OF SUBROUTINE CALCK1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCN3 +C *** CASE N3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. THERE IS ONLY A LIQUID PHASE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCN3 + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NH4I, NO3I, NH3AQ, NO3AQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + CALAOU =.TRUE. ! Outer loop activity calculation flag + FRST =.TRUE. + CALAIN =.TRUE. +C +C *** AEROSOL WATER CONTENT +C + MOLALR(4) = MIN(WAER(2),0.5d0*WAER(3)) ! (NH4)2SO4 + AML5 = MAX(WAER(3)-2.D0*MOLALR(4),ZERO) ! "free" NH4 + MOLALR(5) = MAX(MIN(AML5,WAER(4)), ZERO) ! NH4NO3=MIN("free",NO3) + WATER = MOLALR(4)/M0(4) + MOLALR(5)/M0(5) + WATER = MAX(WATER, TINY) +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A2 = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2. +CC A21 = XK21*WATER*R*TEMP + A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 + A4 = XK7*(WATER/GAMA(4))**3.0 + AKW = XKW *RH*WATER*WATER +C +C ION CONCENTRATIONS +C + NH4I = WAER(3) + NO3I = WAER(4) + SO4I = WAER(2) + HSO4I = ZERO +C + CALL CALCPH (2.D0*SO4I + NO3I - NH4I, HI, OHI) +C +C AMMONIA ASSOCIATION EQUILIBRIUM +C + NH3AQ = ZERO + NO3AQ = ZERO + GG = 2.D0*SO4I + NO3I - NH4I + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + HI = ZERO + CALL CALCNIAQ2 (GG, NO3I, HI, NO3AQ) ! HNO3 +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL (1) = HI + MOLAL (3) = NH4I + MOLAL (5) = SO4I + MOLAL (6) = HSO4I + MOLAL (7) = NO3I + COH = OHI +C + CNH42S4 = ZERO + CNH4NO3 = ZERO +C + GASAQ(1) = NH3AQ + GASAQ(3) = NO3AQ +C + GHNO3 = HI*NO3I/A3 + GNH3 = NH4I/HI/A2 ! NH3AQ/A21 +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ****************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** RETURN *********************************************************** +C +20 RETURN +C +C *** END OF SUBROUTINE CALCN3 ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCN2 +C *** CASE N2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. THERE IS BOTH A LIQUID & SOLID PHASE +C 3. SOLIDS POSSIBLE : (NH4)2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCN2 + INCLUDE 'isrpia.inc' + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + CHI1 = MIN(WAER(2),0.5d0*WAER(3)) ! (NH4)2SO4 + CHI2 = MAX(WAER(3) - 2.D0*CHI1, ZERO) ! "Free" NH4+ + CHI3 = MAX(WAER(4) - CHI2, ZERO) ! "Free" NO3 +C + PSI2 = CHI2 + PSI3 = CHI3 +C + CALAOU = .TRUE. ! Outer loop activity calculation flag + PSI1LO = TINY ! Low limit + PSI1HI = CHI1 ! High limit +C +C *** INITIAL VALUES FOR BISECTION ************************************ +C + X1 = PSI1HI + Y1 = FUNCN2 (X1) + IF (Y1.LE.EPS) RETURN ! IF (ABS(Y1).LE.EPS .OR. Y1.LE.ZERO) RETURN + YHI= Y1 ! Save Y-value at HI position +C +C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ********************** +C + DX = (PSI1HI-PSI1LO)/FLOAT(NDIV) + DO 10 I=1,NDIV + X2 = MAX(X1-DX, ZERO) + Y2 = FUNCN2 (X2) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO) + X1 = X2 + Y1 = Y2 +10 CONTINUE +C +C *** NO SUBDIVISION WITH SOLUTION FOUND +C + YLO= Y1 ! Save Y-value at Hi position + IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION + RETURN +C +C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3 +C + ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN + P4 = CHI4 + YY = FUNCN2(P4) + GOTO 50 +C +C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3 +C + ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN + P4 = TINY + YY = FUNCN2(P4) + GOTO 50 + ELSE + CALL PUSHERR (0001, 'CALCN2') ! WARNING ERROR: NO SOLUTION + RETURN + ENDIF +C +C *** PERFORM BISECTION *********************************************** +C +20 DO 30 I=1,MAXIT + X3 = 0.5*(X1+X2) + Y3 = FUNCN2 (X3) + IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO) + Y2 = Y3 + X2 = X3 + ELSE + Y1 = Y3 + X1 = X3 + ENDIF + IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40 +30 CONTINUE + CALL PUSHERR (0002, 'CALCN2') ! WARNING ERROR: NO CONVERGENCE +C +C *** CONVERGED ; RETURN ********************************************** +C +40 X3 = 0.5*(X1+X2) + Y3 = FUNCN2 (X3) +50 CONTINUE + RETURN +C +C *** END OF SUBROUTINE CALCN2 ****************************************** +C + END + + + +C====================================================================== +C +C *** ISORROPIA CODE +C *** FUNCTION FUNCN2 +C *** CASE D2 +C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ; +C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCN2. +C +C======================================================================= +C + DOUBLE PRECISION FUNCTION FUNCN2 (P1) + INCLUDE 'isrpia.inc' + DOUBLE PRECISION NH4I, NO3I, NH3AQ, NO3AQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. + PSI1 = P1 +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A2 = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2. +CC A21 = XK21*WATER*R*TEMP + A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0 + A4 = XK7*(WATER/GAMA(4))**3.0 + AKW = XKW *RH*WATER*WATER +C +C ION CONCENTRATIONS +C + NH4I = 2.D0*PSI1 + PSI2 + NO3I = PSI2 + PSI3 + SO4I = PSI1 + HSO4I = ZERO +C + CALL CALCPH (2.D0*SO4I + NO3I - NH4I, HI, OHI) +C +C AMMONIA ASSOCIATION EQUILIBRIUM +C + NH3AQ = ZERO + NO3AQ = ZERO + GG = 2.D0*SO4I + NO3I - NH4I + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + HI = ZERO + CALL CALCNIAQ2 (GG, NO3I, HI, NO3AQ) ! HNO3 +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL (1) = HI + MOLAL (3) = NH4I + MOLAL (5) = SO4I + MOLAL (6) = HSO4I + MOLAL (7) = NO3I + COH = OHI +C + CNH42S4 = CHI1 - PSI1 + CNH4NO3 = ZERO +C + GASAQ(1) = NH3AQ + GASAQ(3) = NO3AQ +C + GHNO3 = HI*NO3I/A3 + GNH3 = NH4I/HI/A2 ! NH3AQ/A21 +C +C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES ********************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +C +C *** CALCULATE OBJECTIVE FUNCTION ************************************ +C +20 FUNCN2= NH4I*NH4I*SO4I/A4 - ONE + RETURN +C +C *** END OF FUNCTION FUNCN2 ******************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCN1 +C *** CASE N1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 +C +C THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY: +C 1. RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCN1A) +C 2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION) +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCN1 + INCLUDE 'isrpia.inc' + EXTERNAL CALCN1A, CALCN2 +C +C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY ***************** +C + IF (RH.LT.DRMASAN) THEN + SCASE = 'N1 ; SUBCASE 1' + CALL CALCN1A ! SOLID PHASE ONLY POSSIBLE + SCASE = 'N1 ; SUBCASE 1' + ELSE + SCASE = 'N1 ; SUBCASE 2' + CALL CALCMDRP (RH, DRMASAN, DRNH4NO3, CALCN1A, CALCN2) + SCASE = 'N1 ; SUBCASE 2' + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCN1 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCN1A +C *** CASE N1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCN1A + INCLUDE 'isrpia.inc' +C +C *** SETUP PARAMETERS ************************************************* +C +CCC A1 = XK10/R/TEMP/R/TEMP +C +C *** CALCULATE AEROSOL COMPOSITION ************************************ +C +CCC CHI1 = 2.D0*WAER(4) ! Free parameter ; arbitrary value. + PSI1 = WAER(4) +C +C *** The following statment is here to avoid negative NH4+ values in +C CALCN? routines that call CALCN1A +C + PSI2 = MAX(MIN(WAER(2),0.5d0*(WAER(3)-PSI1)),TINY) +C + CNH4NO3 = PSI1 + CNH42S4 = PSI2 +C +CCC GNH3 = CHI1 + PSI1 + 2.0*PSI2 +CCC GHNO3 = A1/(CHI1-PSI1) + PSI1 + GNH3 = ZERO + GHNO3 = ZERO +C + W(2) = PSI2 + W(3) = GNH3 + PSI1 + 2.0*PSI2 + W(4) = GHNO3 + PSI1 +C + RETURN +C +C *** END OF SUBROUTINE CALCN1A ***************************************** +C + END + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ5 +C *** CASE Q5 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ5 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST =.TRUE. + CALAIN =.TRUE. + CALAOU =.TRUE. +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCQ1A +C + PSI1 = CNA2SO4 ! SALTS DISSOLVED + PSI4 = CNH4CL + PSI5 = CNH4NO3 + PSI6 = CNH42S4 +C + CALL CALCMR ! WATER +C + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C ION CONCENTRATIONS +C + NAI = WAER(1) + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + HSO4I = ZERO + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCQ5') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = ZERO +C + RETURN +C +C *** END OF SUBROUTINE CALCQ5 ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ4 +C *** CASE Q4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ4 + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV1 + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST =.TRUE. + CALAIN =.TRUE. + CALAOU =.TRUE. +C + PSCONV1 =.TRUE. + PSI1O =-GREAT + ROOT3 = ZERO +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCQ1A +C + CHI1 = CNA2SO4 ! SALTS +C + PSI1 = CNA2SO4 ! AMOUNT DISSOLVED + PSI4 = CNH4CL + PSI5 = CNH4NO3 + PSI6 = CNH42S4 +C + CALL CALCMR ! WATER +C + NAI = WAER(1) ! LIQUID CONCENTRATIONS + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C SODIUM SULFATE +C + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-(WAER(2) + WAER(1)) + CC = WAER(1)*WAER(2) + 0.25*WAER(1)*WAER(1) + DD =-0.25*(WAER(1)*WAER(1)*WAER(2) - A5) + CALL POLY3(BB, CC, DD, ROOT3, ISLV) + IF (ISLV.NE.0) ROOT3 = TINY + ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2), CHI1) + ROOT3 = MAX (ROOT3, ZERO) + PSI1 = CHI1-ROOT3 + ENDIF + PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O + PSI1O = PSI1 +C +C ION CONCENTRATIONS ; CORRECTIONS +C + NAI = WAER(1) - 2.D0*ROOT3 + SO4I= WAER(2) - ROOT3 + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + HSO4I = ZERO + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV1) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCQ4') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = CHI1 - PSI1 +C + RETURN +C +C *** END OF SUBROUTINE CALCQ4 ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ3 +C *** CASE Q3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : NH4CL, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ3 + INCLUDE 'isrpia.inc' + LOGICAL EXNO, EXCL + EXTERNAL CALCQ1A, CALCQ4 +C +C *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** +C + EXNO = WAER(4).GT.TINY + EXCL = WAER(5).GT.TINY +C + IF (EXNO .OR. EXCL) THEN ! *** NITRATE OR CHLORIDE EXISTS + SCASE = 'Q3 ; SUBCASE 1' + CALL CALCQ3A + SCASE = 'Q3 ; SUBCASE 1' +C + ELSE ! *** NO CHLORIDE AND NITRATE + IF (RH.LT.DRMG3) THEN + SCASE = 'Q3 ; SUBCASE 2' + CALL CALCQ1A ! SOLID + SCASE = 'Q3 ; SUBCASE 2' + ELSE + SCASE = 'Q3 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4 + CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4) + SCASE = 'Q3 ; SUBCASE 3' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCQ3 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ3A +C *** CASE Q3 ; SUBCASE A +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ3A + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV1, PSCONV6 + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST =.TRUE. + CALAIN =.TRUE. + CALAOU =.TRUE. +C + PSCONV1 =.TRUE. + PSCONV6 =.TRUE. +C + PSI1O =-GREAT + PSI6O =-GREAT +C + ROOT1 = ZERO + ROOT3 = ZERO +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCQ1A +C + CHI1 = CNA2SO4 ! SALTS + CHI4 = CNH4CL + CHI6 = CNH42S4 +C + PSI1 = CNA2SO4 ! AMOUNT DISSOLVED + PSI4 = CNH4CL + PSI5 = CNH4NO3 + PSI6 = CNH42S4 +C + CALL CALCMR ! WATER +C + NAI = WAER(1) ! LIQUID CONCENTRATIONS + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + A7 = XK7 *(WATER/GAMA(4))**3. ! (NH4)2SO4 <==> Na+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C SODIUM SULFATE +C + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-(WAER(2) + WAER(1) - ROOT1) + CC = WAER(1)*(WAER(2) - ROOT1) + 0.25*WAER(1)*WAER(1) + DD =-0.25*(WAER(1)*WAER(1)*(WAER(2) - ROOT1) - A5) + CALL POLY3(BB, CC, DD, ROOT3, ISLV) + IF (ISLV.NE.0) ROOT3 = TINY + ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2) - ROOT1, CHI1) + ROOT3 = MAX (ROOT3, ZERO) + PSI1 = CHI1-ROOT3 + ENDIF + PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O + PSI1O = PSI1 +C +C AMMONIUM SULFATE +C + IF (NH4I*NH4I*SO4I .GT. A4) THEN + BB =-(WAER(2)+WAER(3)-ROOT3) + CC = WAER(3)*(WAER(2)-ROOT3+0.5D0*WAER(3)) + DD =-((WAER(2)-ROOT3)*WAER(3)**2.D0 + A4)/4.D0 + CALL POLY3(BB, CC, DD, ROOT1, ISLV) + IF (ISLV.NE.0) ROOT1 = TINY + ROOT1 = MIN(ROOT1, WAER(3), WAER(2)-ROOT3, CHI6) + ROOT1 = MAX(ROOT1, ZERO) + PSI6 = CHI6-ROOT1 + ENDIF + PSCONV6 = ABS(PSI6-PSI6O) .LE. EPS*PSI6O + PSI6O = PSI6 +C +C ION CONCENTRATIONS +C + NAI = WAER(1) - 2.D0*ROOT3 + SO4I= WAER(2) - ROOT1 - ROOT3 + NH4I= WAER(3) - 2.D0*ROOT1 + NO3I= WAER(4) + CLI = WAER(5) +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + HSO4I = ZERO + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV1 .AND. PSCONV6) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCQ3A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = CHI6 - PSI6 + CNH4NO3 = ZERO + CNH4CL = ZERO + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = CHI1 - PSI1 +C + RETURN +C +C *** END OF SUBROUTINE CALCQ3A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ2 +C *** CASE Q2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID & LIQUID AEROSOL POSSIBLE +C 3. SOLIDS POSSIBLE : NH4CL, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ2 + INCLUDE 'isrpia.inc' + LOGICAL EXNO, EXCL + EXTERNAL CALCQ1A, CALCQ3A, CALCQ4 +C +C *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** +C + EXNO = WAER(4).GT.TINY + EXCL = WAER(5).GT.TINY +C + IF (EXNO) THEN ! *** NITRATE EXISTS + SCASE = 'Q2 ; SUBCASE 1' + CALL CALCQ2A + SCASE = 'Q2 ; SUBCASE 1' +C + ELSEIF (.NOT.EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS + IF (RH.LT.DRMG2) THEN + SCASE = 'Q2 ; SUBCASE 2' + CALL CALCQ1A ! SOLID + SCASE = 'Q2 ; SUBCASE 2' + ELSE + SCASE = 'Q2 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4, NH4CL + CALL CALCMDRP (RH, DRMG2, DRNH4CL, CALCQ1A, CALCQ3A) + SCASE = 'Q2 ; SUBCASE 3' + ENDIF +C + ELSE ! *** NO CHLORIDE AND NITRATE + IF (RH.LT.DRMG3) THEN + SCASE = 'Q2 ; SUBCASE 2' + CALL CALCQ1A ! SOLID + SCASE = 'Q2 ; SUBCASE 2' + ELSE + SCASE = 'Q2 ; SUBCASE 4' ! MDRH (NH4)2SO4, NA2SO4 + CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4) + SCASE = 'Q2 ; SUBCASE 4' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCQ2 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ2A +C *** CASE Q2 ; SUBCASE A +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ2A + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV1, PSCONV4, PSCONV6 + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST =.TRUE. + CALAIN =.TRUE. + CALAOU =.TRUE. +C + PSCONV1 =.TRUE. + PSCONV4 =.TRUE. + PSCONV6 =.TRUE. +C + PSI1O =-GREAT + PSI4O =-GREAT + PSI6O =-GREAT +C + ROOT1 = ZERO + ROOT2 = ZERO + ROOT3 = ZERO +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCQ1A +C + CHI1 = CNA2SO4 ! SALTS + CHI4 = CNH4CL + CHI6 = CNH42S4 +C + PSI1 = CNA2SO4 ! AMOUNT DISSOLVED + PSI4 = CNH4CL + PSI5 = CNH4NO3 + PSI6 = CNH42S4 +C + CALL CALCMR ! WATER +C + NAI = WAER(1) ! LIQUID CONCENTRATIONS + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ + A7 = XK7 *(WATER/GAMA(4))**3. ! (NH4)2SO4 <==> Na+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C AMMONIUM CHLORIDE +C + IF (NH4I*CLI .GT. A14) THEN + BB =-(WAER(3) + WAER(5) - 2.D0*ROOT1) + CC = WAER(5)*(WAER(3) - 2.D0*ROOT1) - A14 + DD = BB*BB - 4.D0*CC + IF (DD.LT.ZERO) THEN + ROOT2 = ZERO + ELSE + DD = SQRT(DD) + ROOT2A= 0.5D0*(-BB+DD) + ROOT2B= 0.5D0*(-BB-DD) + IF (ZERO.LE.ROOT2A) THEN + ROOT2 = ROOT2A + ELSE + ROOT2 = ROOT2B + ENDIF + ROOT2 = MIN(ROOT2, WAER(5), WAER(3) - 2.D0*ROOT1, CHI4) + ROOT2 = MAX(ROOT2, ZERO) + PSI4 = CHI4 - ROOT2 + ENDIF + ENDIF + PSCONV4 = ABS(PSI4-PSI4O) .LE. EPS*PSI4O + PSI4O = PSI4 +C +C SODIUM SULFATE +C + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-(WAER(2) + WAER(1) - ROOT1) + CC = WAER(1)*(WAER(2) - ROOT1) + 0.25*WAER(1)*WAER(1) + DD =-0.25*(WAER(1)*WAER(1)*(WAER(2) - ROOT1) - A5) + CALL POLY3(BB, CC, DD, ROOT3, ISLV) + IF (ISLV.NE.0) ROOT3 = TINY + ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2) - ROOT1, CHI1) + ROOT3 = MAX (ROOT3, ZERO) + PSI1 = CHI1-ROOT3 + ENDIF + PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O + PSI1O = PSI1 +C +C AMMONIUM SULFATE +C + IF (NH4I*NH4I*SO4I .GT. A4) THEN + BB =-(WAER(2)+WAER(3)-ROOT2-ROOT3) + CC = (WAER(3)-ROOT2)*(WAER(2)-ROOT3+0.5D0*(WAER(3)-ROOT2)) + DD =-((WAER(2)-ROOT3)*(WAER(3)-ROOT2)**2.D0 + A4)/4.D0 + CALL POLY3(BB, CC, DD, ROOT1, ISLV) + IF (ISLV.NE.0) ROOT1 = TINY + ROOT1 = MIN(ROOT1, WAER(3)-ROOT2, WAER(2)-ROOT3, CHI6) + ROOT1 = MAX(ROOT1, ZERO) + PSI6 = CHI6-ROOT1 + ENDIF + PSCONV6 = ABS(PSI6-PSI6O) .LE. EPS*PSI6O + PSI6O = PSI6 +C +C ION CONCENTRATIONS +C + NAI = WAER(1) - 2.D0*ROOT3 + SO4I= WAER(2) - ROOT1 - ROOT3 + NH4I= WAER(3) - ROOT2 - 2.D0*ROOT1 + NO3I= WAER(4) + CLI = WAER(5) - ROOT2 +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + HSO4I = ZERO + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV1 .AND. PSCONV4 .AND. PSCONV6) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCQ2A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = CHI6 - PSI6 + CNH4NO3 = ZERO + CNH4CL = CHI4 - PSI4 + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = CHI1 - PSI1 +C + RETURN +C +C *** END OF SUBROUTINE CALCQ2A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ1 +C *** CASE Q1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, (NH4)2SO4, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ1 + INCLUDE 'isrpia.inc' + LOGICAL EXNO, EXCL + EXTERNAL CALCQ1A, CALCQ2A, CALCQ3A, CALCQ4 +C +C *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES *** +C + EXNO = WAER(4).GT.TINY + EXCL = WAER(5).GT.TINY +C + IF (EXNO .AND. EXCL) THEN ! *** NITRATE & CHLORIDE EXIST + IF (RH.LT.DRMG1) THEN + SCASE = 'Q1 ; SUBCASE 1' + CALL CALCQ1A ! SOLID + SCASE = 'Q1 ; SUBCASE 1' + ELSE + SCASE = 'Q1 ; SUBCASE 2' ! MDRH (NH4)2SO4, NA2SO4, NH4CL, NH4NO3 + CALL CALCMDRP (RH, DRMG1, DRNH4NO3, CALCQ1A, CALCQ2A) + SCASE = 'Q1 ; SUBCASE 2' + ENDIF +C + ELSE IF (EXNO .AND. .NOT.EXCL) THEN ! *** ONLY NITRATE EXISTS + IF (RH.LT.DRMQ1) THEN + SCASE = 'Q1 ; SUBCASE 1' + CALL CALCQ1A ! SOLID + SCASE = 'Q1 ; SUBCASE 1' + ELSE + SCASE = 'Q1 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4, NH4NO3 + CALL CALCMDRP (RH, DRMQ1, DRNH4NO3, CALCQ1A, CALCQ2A) + SCASE = 'Q1 ; SUBCASE 3' + ENDIF +C + ELSE IF (.NOT.EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS + IF (RH.LT.DRMG2) THEN + SCASE = 'Q1 ; SUBCASE 1' + CALL CALCQ1A ! SOLID + SCASE = 'Q1 ; SUBCASE 1' + ELSE + SCASE = 'Q1 ; SUBCASE 4' ! MDRH (NH4)2SO4, NA2SO4, NH4CL + CALL CALCMDRP (RH, DRMG2, DRNH4CL, CALCQ1A, CALCQ3A) + SCASE = 'Q1 ; SUBCASE 4' + ENDIF +C + ELSE ! *** NO CHLORIDE AND NITRATE + IF (RH.LT.DRMG3) THEN + SCASE = 'Q1 ; SUBCASE 1' + CALL CALCQ1A ! SOLID + SCASE = 'Q1 ; SUBCASE 1' + ELSE + SCASE = 'Q1 ; SUBCASE 5' ! MDRH (NH4)2SO4, NA2SO4 + CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4) + SCASE = 'Q1 ; SUBCASE 5' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCQ1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCQ1A +C *** CASE Q1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, (NH4)2SO4, NA2SO4 +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCQ1A + INCLUDE 'isrpia.inc' +C +C *** CALCULATE SOLIDS ************************************************** +C + CNA2SO4 = 0.5d0*WAER(1) + FRSO4 = MAX (WAER(2)-CNA2SO4, ZERO) +C + CNH42S4 = MAX (MIN(FRSO4,0.5d0*WAER(3)), TINY) + FRNH3 = MAX (WAER(3)-2.D0*CNH42S4, ZERO) +C + CNH4NO3 = MIN (FRNH3, WAER(4)) +CCC FRNO3 = MAX (WAER(4)-CNH4NO3, ZERO) + FRNH3 = MAX (FRNH3-CNH4NO3, ZERO) +C + CNH4CL = MIN (FRNH3, WAER(5)) +CCC FRCL = MAX (WAER(5)-CNH4CL, ZERO) + FRNH3 = MAX (FRNH3-CNH4CL, ZERO) +C +C *** OTHER PHASES ****************************************************** +C + WATER = ZERO +C + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO +C + RETURN +C +C *** END OF SUBROUTINE CALCQ1A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR6 +C *** CASE R6 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) +C 2. THERE IS ONLY A LIQUID PHASE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR6 + INCLUDE 'isrpia.inc' +C + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + CALL CALCR1A +C + PSI1 = CNA2SO4 + PSI2 = CNANO3 + PSI3 = CNACL + PSI4 = CNH4CL + PSI5 = CNH4NO3 +C + FRST = .TRUE. + CALAIN = .TRUE. + CALAOU = .TRUE. +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** SETUP LIQUID CONCENTRATIONS ************************************** +C + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C + NAI = WAER(1) + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*WAER(2) + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCR6') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1) = NH3AQ + GASAQ(2) = CLAQ + GASAQ(3) = NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = ZERO +C + RETURN +C +C *** END OF SUBROUTINE CALCR6 ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR5 +C *** CASE R5 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR5 + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C + LOGICAL NEAN, NEAC, NESN, NESC +C +C *** SETUP PARAMETERS ************************************************ +C + CALL CALCR1A ! DRY SOLUTION +C + NEAN = CNH4NO3.LE.TINY ! NH4NO3 ! Water exists? + NEAC = CNH4CL .LE.TINY ! NH4CL + NESN = CNANO3 .LE.TINY ! NANO3 + NESC = CNACL .LE.TINY ! NACL + IF (NEAN .AND. NEAC .AND. NESN .AND. NESC) RETURN +C + CHI1 = CNA2SO4 +C + PSI1 = CNA2SO4 + PSI2 = CNANO3 + PSI3 = CNACL + PSI4 = CNH4CL + PSI5 = CNH4NO3 +C + PSIO =-GREAT +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C + FRST = .TRUE. + CALAIN = .TRUE. + CALAOU = .TRUE. + PSCONV = .FALSE. +C +C *** SETUP LIQUID CONCENTRATIONS ************************************** +C + NAI = WAER(1) + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5*(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C SODIUM SULFATE +C + ROOT = ZERO + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-3.D0*CHI1 + CC = 3.D0*CHI1**2.0 + DD =-CHI1**3.0 + 0.25D0*A5 + CALL POLY3(BB, CC, DD, ROOT, ISLV) + IF (ISLV.NE.0) ROOT = TINY + ROOT = MIN (MAX(ROOT,ZERO), CHI1) + PSI1 = CHI1-ROOT + ENDIF + PSCONV = ABS(PSI1-PSIO) .LE. EPS*PSIO + PSIO = PSI1 +C +C ION CONCENTRATIONS +C + NAI = WAER(1) - 2.D0*ROOT + SO4I = WAER(2) - ROOT + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCR5') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ +CC A21 = XK21*WATER*R*TEMP + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 ! NH4I*OHI/A2/AKW + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1) = NH3AQ + GASAQ(2) = CLAQ + GASAQ(3) = NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = ZERO + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = CHI1 - PSI1 +C + RETURN +C +C *** END OF SUBROUTINE CALCR5 ****************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR4 +C *** CASE R4 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR4 + INCLUDE 'isrpia.inc' + LOGICAL EXAN, EXAC, EXSN, EXSC + EXTERNAL CALCR1A, CALCR5 +C +C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** +C + SCASE = 'R4 ; SUBCASE 2' + CALL CALCR1A ! SOLID + SCASE = 'R4 ; SUBCASE 2' +C + EXAN = CNH4NO3.GT.TINY ! NH4NO3 + EXAC = CNH4CL .GT.TINY ! NH4CL + EXSN = CNANO3 .GT.TINY ! NANO3 + EXSC = CNACL .GT.TINY ! NACL +C +C *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** +C + IF (EXAN .OR. EXSN .OR. EXSC) THEN ! *** NH4NO3,NANO3 EXIST + IF (RH.GE.DRMH1) THEN + SCASE = 'R4 ; SUBCASE 1' + CALL CALCR4A + SCASE = 'R4 ; SUBCASE 1' + ENDIF +C + ELSE IF (EXAC) THEN ! *** NH4CL EXISTS ONLY + IF (RH.GE.DRMR5) THEN + SCASE = 'R4 ; SUBCASE 3' + CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR5) + SCASE = 'R4 ; SUBCASE 3' + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCR4 ****************************************** +C + END + + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR4A +C *** CASE R4A +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR4A + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV1, PSCONV4 + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST = .TRUE. + CALAIN = .TRUE. + CALAOU = .TRUE. + PSCONV1 = .FALSE. + PSCONV4 = .FALSE. + PSIO1 =-GREAT + PSIO4 =-GREAT +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCR1A +C + CHI1 = CNA2SO4 ! SALTS + CHI4 = CNH4CL +C + PSI1 = CNA2SO4 + PSI2 = CNANO3 + PSI3 = CNACL + PSI4 = CNH4CL + PSI5 = CNH4NO3 +C + CALL CALCMR ! WATER +C + NAI = WAER(1) ! LIQUID CONCENTRATIONS + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C SODIUM SULFATE +C + ROOT = ZERO + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-3.D0*CHI1 + CC = 3.D0*CHI1**2.0 + DD =-CHI1**3.0 + 0.25D0*A5 + CALL POLY3(BB, CC, DD, ROOT, ISLV) + IF (ISLV.NE.0) ROOT = TINY + ROOT = MIN (MAX(ROOT,ZERO), CHI1) + PSI1 = CHI1-ROOT + NAI = WAER(1) - 2.D0*ROOT + SO4I = WAER(2) - ROOT + ENDIF + PSCONV1 = ABS(PSI1-PSIO1) .LE. EPS*PSIO1 + PSIO1 = PSI1 +C +C AMMONIUM CHLORIDE +C + ROOT = ZERO + IF (NH4I*CLI .GT. A14) THEN + BB =-(NH4I + CLI) + CC =-A14 + NH4I*CLI + DD = BB*BB - 4.D0*CC + ROOT = 0.5D0*(-BB-SQRT(DD)) + IF (ROOT.GT.TINY) THEN + ROOT = MIN(ROOT, CHI4) + PSI4 = CHI4 - ROOT + NH4I = WAER(3) - ROOT + CLI = WAER(5) - ROOT + ENDIF + ENDIF + PSCONV4 = ABS(PSI4-PSIO4) .LE. EPS*PSIO4 + PSIO4 = PSI4 +C + NO3I = WAER(4) +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV1 .AND. PSCONV4) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCR4A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = CHI4 - PSI4 + CNACL = ZERO + CNANO3 = ZERO + CNA2SO4 = CHI1 - PSI1 +C + RETURN +C +C *** END OF SUBROUTINE CALCR4A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR3 +C *** CASE R3 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR3 + INCLUDE 'isrpia.inc' + LOGICAL EXAN, EXAC, EXSN, EXSC + EXTERNAL CALCR1A, CALCR4A, CALCR5 +C +C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** +C + SCASE = 'R3 ; SUBCASE 2' + CALL CALCR1A ! SOLID + SCASE = 'R3 ; SUBCASE 2' +C + EXAN = CNH4NO3.GT.TINY ! NH4NO3 + EXAC = CNH4CL .GT.TINY ! NH4CL + EXSN = CNANO3 .GT.TINY ! NANO3 + EXSC = CNACL .GT.TINY ! NACL +C +C *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** +C + IF (EXAN .OR. EXSN) THEN ! *** NH4NO3,NANO3 EXIST + IF (RH.GE.DRMH1) THEN + SCASE = 'R3 ; SUBCASE 1' + CALL CALCR3A + SCASE = 'R3 ; SUBCASE 1' + ENDIF +C + ELSE IF (.NOT.EXAN .AND. .NOT.EXSN) THEN ! *** NH4NO3,NANO3 = 0 + IF ( EXAC .AND. EXSC) THEN + IF (RH.GE.DRMR4) THEN + SCASE = 'R3 ; SUBCASE 3' + CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR4A) + SCASE = 'R3 ; SUBCASE 3' + ENDIF + + ELSE IF (.NOT.EXAC .AND. EXSC) THEN + IF (RH.GE.DRMR2) THEN + SCASE = 'R3 ; SUBCASE 4' + CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR4A) + SCASE = 'R3 ; SUBCASE 4' + ENDIF + + ELSE IF ( EXAC .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR5) THEN + SCASE = 'R3 ; SUBCASE 5' + CALL CALCMDRP (RH, DRMR5, DRNACL, CALCR1A, CALCR5) + SCASE = 'R3 ; SUBCASE 5' + ENDIF + ENDIF +C + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCR3 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR3A +C *** CASE R3A +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR3A + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV1, PSCONV3, PSCONV4 + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST =.TRUE. + CALAIN =.TRUE. + CALAOU =.TRUE. + PSCONV1 =.TRUE. + PSCONV3 =.TRUE. + PSCONV4 =.TRUE. + PSI1O =-GREAT + PSI3O =-GREAT + PSI4O =-GREAT + ROOT1 = ZERO + ROOT2 = ZERO + ROOT3 = ZERO +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCR1A +C + CHI1 = CNA2SO4 ! SALTS + CHI4 = CNH4CL + CHI3 = CNACL +C + PSI1 = CNA2SO4 + PSI2 = CNANO3 + PSI3 = CNACL + PSI4 = CNH4CL + PSI5 = CNH4NO3 +C + CALL CALCMR ! WATER +C + NAI = WAER(1) ! LIQUID CONCENTRATIONS + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C + MOLAL(1) = ZERO + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C + CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + A8 = XK8 *(WATER/GAMA(1))**2. ! NaCl <==> Na+ + A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C AMMONIUM CHLORIDE +C + IF (NH4I*CLI .GT. A14) THEN + BB =-(WAER(3) + WAER(5) - ROOT3) + CC =-A14 + NH4I*(WAER(5) - ROOT3) + DD = MAX(BB*BB - 4.D0*CC, ZERO) + ROOT2A= 0.5D0*(-BB+SQRT(DD)) + ROOT2B= 0.5D0*(-BB-SQRT(DD)) + IF (ZERO.LE.ROOT2A) THEN + ROOT2 = ROOT2A + ELSE + ROOT2 = ROOT2B + ENDIF + ROOT2 = MIN(MAX(ZERO, ROOT2), MAX(WAER(5)-ROOT3,ZERO), + & CHI4, WAER(3)) + PSI4 = CHI4 - ROOT2 + ENDIF + PSCONV4 = ABS(PSI4-PSI4O) .LE. EPS*PSI4O + PSI4O = PSI4 +C +C SODIUM SULFATE +C + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-(CHI1 + WAER(1) - ROOT3) + CC = 0.25D0*(WAER(1) - ROOT3)*(4.D0*CHI1+WAER(1)-ROOT3) + DD =-0.25D0*(CHI1*(WAER(1)-ROOT3)**2.D0 - A5) + CALL POLY3(BB, CC, DD, ROOT1, ISLV) + IF (ISLV.NE.0) ROOT1 = TINY + ROOT1 = MIN (MAX(ROOT1,ZERO), MAX(WAER(1)-ROOT3,ZERO), + & CHI1, WAER(2)) + PSI1 = CHI1-ROOT1 + ENDIF + PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O + PSI1O = PSI1 +C +C ION CONCENTRATIONS +C + NAI = WAER(1) - (2.D0*ROOT1 + ROOT3) + SO4I= WAER(2) - ROOT1 + NH4I= WAER(3) - ROOT2 + CLI = WAER(5) - (ROOT3 + ROOT2) + NO3I= WAER(4) +C +C SODIUM CHLORIDE ; To obtain new value for ROOT3 +C + IF (NAI*CLI .GT. A8) THEN + BB =-((CHI1-2.D0*ROOT1) + (WAER(5) - ROOT2)) + CC = (CHI1-2.D0*ROOT1)*(WAER(5) - ROOT2) - A8 + DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) + ROOT3A= 0.5D0*(-BB-SQRT(DD)) + ROOT3B= 0.5D0*(-BB+SQRT(DD)) + IF (ZERO.LE.ROOT3A) THEN + ROOT3 = ROOT3A + ELSE + ROOT3 = ROOT3B + ENDIF + ROOT3 = MIN(MAX(ROOT3, ZERO), CHI3) + PSI3 = CHI3-ROOT3 + ENDIF + PSCONV3 = ABS(PSI3-PSI3O) .LE. EPS*PSI3O + PSI3O = PSI3 +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV1.AND.PSCONV3.AND.PSCONV4) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCR3A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 IF (CLI.LE.TINY .AND. WAER(5).GT.TINY) THEN !No disslv Cl-;solid only + DO 30 I=1,NIONS + MOLAL(I) = ZERO +30 CONTINUE + DO 40 I=1,NGASAQ + GASAQ(I) = ZERO +40 CONTINUE + CALL CALCR1A + ELSE + A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = CHI4 - PSI4 + CNACL = CHI3 - PSI3 + CNANO3 = ZERO + CNA2SO4 = CHI1 - PSI1 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCR3A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR2 +C *** CASE R2 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR2 + INCLUDE 'isrpia.inc' + LOGICAL EXAN, EXAC, EXSN, EXSC + EXTERNAL CALCR1A, CALCR3A, CALCR4A, CALCR5 +C +C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** +C + SCASE = 'R2 ; SUBCASE 2' + CALL CALCR1A ! SOLID + SCASE = 'R2 ; SUBCASE 2' +C + EXAN = CNH4NO3.GT.TINY ! NH4NO3 + EXAC = CNH4CL .GT.TINY ! NH4CL + EXSN = CNANO3 .GT.TINY ! NANO3 + EXSC = CNACL .GT.TINY ! NACL +C +C *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** +C + IF (EXAN) THEN ! *** NH4NO3 EXISTS + IF (RH.GE.DRMH1) THEN + SCASE = 'R2 ; SUBCASE 1' + CALL CALCR2A + SCASE = 'R2 ; SUBCASE 1' + ENDIF +C + ELSE IF (.NOT.EXAN) THEN ! *** NH4NO3 = 0 + IF ( EXAC .AND. EXSN .AND. EXSC) THEN + IF (RH.GE.DRMH2) THEN + SCASE = 'R2 ; SUBCASE 3' + CALL CALCMDRP (RH, DRMH2, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R2 ; SUBCASE 3' + ENDIF + + ELSE IF (.NOT.EXAC .AND. EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR1) THEN + SCASE = 'R2 ; SUBCASE 4' + CALL CALCMDRP (RH, DRMR1, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R2 ; SUBCASE 4' + ENDIF + + ELSE IF (.NOT.EXAC .AND. .NOT.EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR2) THEN + SCASE = 'R2 ; SUBCASE 5' + CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR4A) + SCASE = 'R2 ; SUBCASE 5' + ENDIF + + ELSE IF (.NOT.EXAC .AND. EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR3) THEN + SCASE = 'R2 ; SUBCASE 6' + CALL CALCMDRP (RH, DRMR3, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R2 ; SUBCASE 6' + ENDIF + + ELSE IF ( EXAC .AND. .NOT.EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR4) THEN + SCASE = 'R2 ; SUBCASE 7' + CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR4A) + SCASE = 'R2 ; SUBCASE 7' + ENDIF + + ELSE IF ( EXAC .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR5) THEN + SCASE = 'R2 ; SUBCASE 8' + CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR5) + SCASE = 'R2 ; SUBCASE 8' + ENDIF + + ELSE IF ( EXAC .AND. EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR6) THEN + SCASE = 'R2 ; SUBCASE 9' + CALL CALCMDRP (RH, DRMR6, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R2 ; SUBCASE 9' + ENDIF + ENDIF +C + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCR2 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR2A +C *** CASE R2A +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0) +C 2. LIQUID AND SOLID PHASES ARE POSSIBLE +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR2A + INCLUDE 'isrpia.inc' +C + LOGICAL PSCONV1, PSCONV2, PSCONV3, PSCONV4 + DOUBLE PRECISION NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ + COMMON /SOLUT/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, + & PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, PSI8, + & A1, A2, A3, A4, A5, A6, A7, A8 +C +C *** SETUP PARAMETERS ************************************************ +C + FRST =.TRUE. + CALAIN =.TRUE. + CALAOU =.TRUE. +C + PSCONV1 =.TRUE. + PSCONV2 =.TRUE. + PSCONV3 =.TRUE. + PSCONV4 =.TRUE. +C + PSI1O =-GREAT + PSI2O =-GREAT + PSI3O =-GREAT + PSI4O =-GREAT +C + ROOT1 = ZERO + ROOT2 = ZERO + ROOT3 = ZERO + ROOT4 = ZERO +C +C *** CALCULATE INITIAL SOLUTION *************************************** +C + CALL CALCR1A +C + CHI1 = CNA2SO4 ! SALTS + CHI2 = CNANO3 + CHI3 = CNACL + CHI4 = CNH4CL +C + PSI1 = CNA2SO4 + PSI2 = CNANO3 + PSI3 = CNACL + PSI4 = CNH4CL + PSI5 = CNH4NO3 +C + CALL CALCMR ! WATER +C + NAI = WAER(1) ! LIQUID CONCENTRATIONS + SO4I = WAER(2) + NH4I = WAER(3) + NO3I = WAER(4) + CLI = WAER(5) + HSO4I = ZERO + NH3AQ = ZERO + NO3AQ = ZERO + CLAQ = ZERO +C + MOLAL(1) = ZERO + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C + CALL CALCACT ! CALCULATE ACTIVITY COEFFICIENTS +C +C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************ +C + DO 10 I=1,NSWEEP + A5 = XK5 *(WATER/GAMA(2))**3. ! Na2SO4 <==> Na+ + A8 = XK8 *(WATER/GAMA(1))**2. ! NaCl <==> Na+ + A9 = XK9 *(WATER/GAMA(3))**2. ! NaNO3 <==> Na+ + A14 = XK14*(WATER/GAMA(6))**2. ! NH4Cl <==> NH4+ + AKW = XKW*RH*WATER*WATER ! H2O <==> H+ +C +C AMMONIUM CHLORIDE +C + IF (NH4I*CLI .GT. A14) THEN + BB =-(WAER(3) + WAER(5) - ROOT3) + CC = NH4I*(WAER(5) - ROOT3) - A14 + DD = MAX(BB*BB - 4.D0*CC, ZERO) + DD = SQRT(DD) + ROOT2A= 0.5D0*(-BB+DD) + ROOT2B= 0.5D0*(-BB-DD) + IF (ZERO.LE.ROOT2A) THEN + ROOT2 = ROOT2A + ELSE + ROOT2 = ROOT2B + ENDIF + ROOT2 = MIN(MAX(ROOT2, ZERO), CHI4) + PSI4 = CHI4 - ROOT2 + ENDIF + PSCONV4 = ABS(PSI4-PSI4O) .LE. EPS*PSI4O + PSI4O = PSI4 +C +C SODIUM SULFATE +C + IF (NAI*NAI*SO4I .GT. A5) THEN + BB =-(WAER(2) + WAER(1) - ROOT3 - ROOT4) + CC = WAER(1)*(2.D0*ROOT3 + 2.D0*ROOT4 - 4.D0*WAER(2) - ONE) + & -(ROOT3 + ROOT4)**2.0 + 4.D0*WAER(2)*(ROOT3 + ROOT4) + CC =-0.25*CC + DD = WAER(1)*WAER(2)*(ONE - 2.D0*ROOT3 - 2.D0*ROOT4) + + & WAER(2)*(ROOT3 + ROOT4)**2.0 - A5 + DD =-0.25*DD + CALL POLY3(BB, CC, DD, ROOT1, ISLV) + IF (ISLV.NE.0) ROOT1 = TINY + ROOT1 = MIN (MAX(ROOT1,ZERO), CHI1) + PSI1 = CHI1-ROOT1 + ENDIF + PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O + PSI1O = PSI1 +C +C SODIUM NITRATE +C + IF (NAI*NO3I .GT. A9) THEN + BB =-(WAER(4) + WAER(1) - 2.D0*ROOT1 - ROOT3) + CC = WAER(4)*(WAER(1) - 2.D0*ROOT1 - ROOT3) - A9 + DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) + ROOT4A= 0.5D0*(-BB-DD) + ROOT4B= 0.5D0*(-BB+DD) + IF (ZERO.LE.ROOT4A) THEN + ROOT4 = ROOT4A + ELSE + ROOT4 = ROOT4B + ENDIF + ROOT4 = MIN(MAX(ROOT4, ZERO), CHI2) + PSI2 = CHI2-ROOT4 + ENDIF + PSCONV2 = ABS(PSI2-PSI2O) .LE. EPS*PSI2O + PSI2O = PSI2 +C +C ION CONCENTRATIONS +C + NAI = WAER(1) - (2.D0*ROOT1 + ROOT3 + ROOT4) + SO4I= WAER(2) - ROOT1 + NH4I= WAER(3) - ROOT2 + NO3I= WAER(4) - ROOT4 + CLI = WAER(5) - (ROOT3 + ROOT2) +C +C SODIUM CHLORIDE ; To obtain new value for ROOT3 +C + IF (NAI*CLI .GT. A8) THEN + BB =-(WAER(1) - 2.D0*ROOT1 + WAER(5) - ROOT2 - ROOT4) + CC = (WAER(5) + ROOT2)*(WAER(1) - 2.D0*ROOT1 - ROOT4) - A8 + DD = SQRT(MAX(BB*BB - 4.D0*CC, TINY)) + ROOT3A= 0.5D0*(-BB-DD) + ROOT3B= 0.5D0*(-BB+DD) + IF (ZERO.LE.ROOT3A) THEN + ROOT3 = ROOT3A + ELSE + ROOT3 = ROOT3B + ENDIF + ROOT3 = MIN(MAX(ROOT3, ZERO), CHI3) + PSI3 = CHI3-ROOT3 + ENDIF + PSCONV3 = ABS(PSI3-PSI3O) .LE. EPS*PSI3O + PSI3O = PSI3 +C +C SOLUTION ACIDIC OR BASIC? +C + GG = 2.D0*SO4I + NO3I + CLI - NAI - NH4I + IF (GG.GT.TINY) THEN ! H+ in excess + BB =-GG + CC =-AKW + DD = BB*BB - 4.D0*CC + HI = 0.5D0*(-BB + SQRT(DD)) + OHI= AKW/HI + ELSE ! OH- in excess + BB = GG + CC =-AKW + DD = BB*BB - 4.D0*CC + OHI= 0.5D0*(-BB + SQRT(DD)) + HI = AKW/OHI + ENDIF +C +C UNDISSOCIATED SPECIES EQUILIBRIA +C + IF (HI.LT.OHI) THEN + CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ) + HI = AKW/OHI + ELSE + GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO) + GGCL = MAX(GG-GGNO3, ZERO) + IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl + IF (GGNO3.GT.TINY) THEN + IF (GGCL.LE.TINY) HI = ZERO + CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ) ! HNO3 + ENDIF +C +C CONCENTRATION ADJUSTMENTS ; HSO4 minor species. +C + CALL CALCHS4 (HI, SO4I, ZERO, DEL) + SO4I = SO4I - DEL + HI = HI - DEL + HSO4I = DEL + OHI = AKW/HI + ENDIF +C +C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ****************************** +C + MOLAL(1) = HI + MOLAL(2) = NAI + MOLAL(3) = NH4I + MOLAL(4) = CLI + MOLAL(5) = SO4I + MOLAL(6) = HSO4I + MOLAL(7) = NO3I +C +C *** CALCULATE WATER ************************************************** +C + CALL CALCMR +C +C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ***************** +C + IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN + CALL CALCACT + ELSE + IF (PSCONV1.AND.PSCONV2.AND.PSCONV3.AND.PSCONV4) GOTO 20 + ENDIF +10 CONTINUE +ccc CALL PUSHERR (0002, 'CALCR2A') ! WARNING ERROR: NO CONVERGENCE +C +C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) ********* +C +20 IF (CLI.LE.TINY .AND. WAER(5).GT.TINY) THEN !No disslv Cl-;solid only + DO 30 I=1,NIONS + MOLAL(I) = ZERO +30 CONTINUE + DO 40 I=1,NGASAQ + GASAQ(I) = ZERO +40 CONTINUE + CALL CALCR1A + ELSE ! OK, aqueous phase present + A2 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3 <==> NH4+ + A3 = XK4 *R*TEMP*(WATER/GAMA(10))**2. ! HNO3 <==> NO3- + A4 = XK3 *R*TEMP*(WATER/GAMA(11))**2. ! HCL <==> CL- +C + GNH3 = NH4I/HI/A2 + GHNO3 = HI*NO3I/A3 + GHCL = HI*CLI /A4 +C + GASAQ(1)= NH3AQ + GASAQ(2)= CLAQ + GASAQ(3)= NO3AQ +C + CNH42S4 = ZERO + CNH4NO3 = ZERO + CNH4CL = CHI4 - PSI4 + CNACL = CHI3 - PSI3 + CNANO3 = CHI2 - PSI2 + CNA2SO4 = CHI1 - PSI1 + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCR2A ***************************************** +C + END +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR1 +C *** CASE R1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR1 + INCLUDE 'isrpia.inc' + LOGICAL EXAN, EXAC, EXSN, EXSC + EXTERNAL CALCR1A, CALCR2A, CALCR3A, CALCR4A, CALCR5 +C +C *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE ************** +C + SCASE = 'R1 ; SUBCASE 1' + CALL CALCR1A ! SOLID + SCASE = 'R1 ; SUBCASE 1' +C + EXAN = CNH4NO3.GT.TINY ! NH4NO3 + EXAC = CNH4CL .GT.TINY ! NH4CL + EXSN = CNANO3 .GT.TINY ! NANO3 + EXSC = CNACL .GT.TINY ! NACL +C +C *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES ********** +C + IF (EXAN.AND.EXAC.AND.EXSC.AND.EXSN) THEN ! *** ALL EXIST + IF (RH.GE.DRMH1) THEN + SCASE = 'R1 ; SUBCASE 2' ! MDRH + CALL CALCMDRP (RH, DRMH1, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 2' + ENDIF +C + ELSE IF (.NOT.EXAN) THEN ! *** NH4NO3 = 0 + IF ( EXAC .AND. EXSN .AND. EXSC) THEN + IF (RH.GE.DRMH2) THEN + SCASE = 'R1 ; SUBCASE 3' + CALL CALCMDRP (RH, DRMH2, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R1 ; SUBCASE 3' + ENDIF + + ELSE IF (.NOT.EXAC .AND. EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR1) THEN + SCASE = 'R1 ; SUBCASE 4' + CALL CALCMDRP (RH, DRMR1, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R1 ; SUBCASE 4' + ENDIF + + ELSE IF (.NOT.EXAC .AND. .NOT.EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR2) THEN + SCASE = 'R1 ; SUBCASE 5' + CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR3A) !, CALCR4A) + SCASE = 'R1 ; SUBCASE 5' + ENDIF + + ELSE IF (.NOT.EXAC .AND. EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR3) THEN + SCASE = 'R1 ; SUBCASE 6' + CALL CALCMDRP (RH, DRMR3, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R1 ; SUBCASE 6' + ENDIF + + ELSE IF ( EXAC .AND. .NOT.EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR4) THEN + SCASE = 'R1 ; SUBCASE 7' + CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR3A) !, CALCR4A) + SCASE = 'R1 ; SUBCASE 7' + ENDIF + + ELSE IF ( EXAC .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR5) THEN + SCASE = 'R1 ; SUBCASE 8' + CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR3A) !, CALCR5) + SCASE = 'R1 ; SUBCASE 8' + ENDIF + + ELSE IF ( EXAC .AND. EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR6) THEN + SCASE = 'R1 ; SUBCASE 9' + CALL CALCMDRP (RH, DRMR6, DRNANO3, CALCR1A, CALCR3A) + SCASE = 'R1 ; SUBCASE 9' + ENDIF + ENDIF +C + ELSE IF (.NOT.EXAC) THEN ! *** NH4CL = 0 + IF ( EXAN .AND. EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR7) THEN + SCASE = 'R1 ; SUBCASE 10' + CALL CALCMDRP (RH, DRMR7, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 10' + ENDIF + + ELSE IF ( EXAN .AND. .NOT.EXSN .AND. EXSC) THEN + IF (RH.GE.DRMR8) THEN + SCASE = 'R1 ; SUBCASE 11' + CALL CALCMDRP (RH, DRMR8, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 11' + ENDIF + + ELSE IF ( EXAN .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR9) THEN + SCASE = 'R1 ; SUBCASE 12' + CALL CALCMDRP (RH, DRMR9, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 12' + ENDIF + + ELSE IF ( EXAN .AND. EXSN .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR10) THEN + SCASE = 'R1 ; SUBCASE 13' + CALL CALCMDRP (RH, DRMR10, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 13' + ENDIF + ENDIF +C + ELSE IF (.NOT.EXSN) THEN ! *** NANO3 = 0 + IF ( EXAN .AND. EXAC .AND. EXSC) THEN + IF (RH.GE.DRMR11) THEN + SCASE = 'R1 ; SUBCASE 14' + CALL CALCMDRP (RH, DRMR11, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 14' + ENDIF + + ELSE IF ( EXAN .AND. EXAC .AND. .NOT.EXSC) THEN + IF (RH.GE.DRMR12) THEN + SCASE = 'R1 ; SUBCASE 15' + CALL CALCMDRP (RH, DRMR12, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 15' + ENDIF + ENDIF +C + ELSE IF (.NOT.EXSC) THEN ! *** NACL = 0 + IF ( EXAN .AND. EXAC .AND. EXSN) THEN + IF (RH.GE.DRMR13) THEN + SCASE = 'R1 ; SUBCASE 16' + CALL CALCMDRP (RH, DRMR13, DRNH4NO3, CALCR1A, CALCR2A) + SCASE = 'R1 ; SUBCASE 16' + ENDIF + ENDIF + ENDIF +C + RETURN +C +C *** END OF SUBROUTINE CALCR1 ****************************************** +C + END + + +C======================================================================= +C +C *** ISORROPIA CODE +C *** SUBROUTINE CALCR1A +C *** CASE R1 ; SUBCASE 1 +C +C THE MAIN CHARACTERISTICS OF THIS REGIME ARE: +C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0) +C 2. SOLID AEROSOL ONLY +C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4, NANO3, NACL +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C +C======================================================================= +C + SUBROUTINE CALCR1A + INCLUDE 'isrpia.inc' +C +C *** CALCULATE SOLIDS ************************************************** +C + CNA2SO4 = WAER(2) + FRNA = MAX (WAER(1)-2*CNA2SO4, ZERO) +C + CNH42S4 = ZERO +C + CNANO3 = MIN (FRNA, WAER(4)) + FRNO3 = MAX (WAER(4)-CNANO3, ZERO) + FRNA = MAX (FRNA-CNANO3, ZERO) +C + CNACL = MIN (FRNA, WAER(5)) + FRCL = MAX (WAER(5)-CNACL, ZERO) + FRNA = MAX (FRNA-CNACL, ZERO) +C + CNH4NO3 = MIN (FRNO3, WAER(3)) + FRNO3 = MAX (FRNO3-CNH4NO3, ZERO) + FRNH3 = MAX (WAER(3)-CNH4NO3, ZERO) +C + CNH4CL = MIN (FRCL, FRNH3) + FRCL = MAX (FRCL-CNH4CL, ZERO) + FRNH3 = MAX (FRNH3-CNH4CL, ZERO) +C +C *** OTHER PHASES ****************************************************** +C + WATER = ZERO +C + GNH3 = ZERO + GHNO3 = ZERO + GHCL = ZERO +C + RETURN +C +C *** END OF SUBROUTINE CALCR1A ***************************************** +C + END diff --git a/models/CCTM/aero/blank/isrpia.inc b/models/CCTM/aero/blank/isrpia.inc new file mode 100755 index 0000000..ebc9cf0 --- /dev/null +++ b/models/CCTM/aero/blank/isrpia.inc @@ -0,0 +1,124 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/isrpia.inc,v 1.2 2011/10/21 16:10:05 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C This is ISORROPIA Version 1.7 (3/15/06). More information is available +C at the ISORROPIA homepage: http://nenes.eas.gatech.edu/ISORROPIA/ +C +C======================================================================= +C +C *** ISORROPIA CODE +C *** INCLUDE FILE 'ISRPIA.INC' +C *** THIS FILE CONTAINS THE DECLARATIONS OF THE GLOBAL CONSTANTS +C AND VARIABLES. +C +C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY, +C *** GEORGIA INSTITUTE OF TECHNOLOGY +C *** WRITTEN BY ATHANASIOS NENES +C *** UPDATED BY CHRISTOS FOUNTOUKIS +C +C======================================================================= +C + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + PARAMETER (NCOMP=5,NIONS=7,NGASAQ=3,NSLDS=9,NPAIR=13,NZSR=100, + & NERRMX=25) +C +C *** INPUT VARIABLES ************************************************** +C + INTEGER METSTBL + COMMON /INPT/ W(NCOMP), WAER(NCOMP), TEMP, RH, IPROB, METSTBL, + & NADJ +C +C *** WATER ACTIVITIES OF PURE SALT SOLUTIONS ************************** +C + COMMON /ZSR / AWAS(NZSR), AWSS(NZSR), AWAC(NZSR), AWSC(NZSR), + & AWAN(NZSR), AWSN(NZSR), AWSB(NZSR), AWAB(NZSR), + & AWSA(NZSR), AWLC(NZSR) +C +C *** DELIQUESCENCE RELATIVE HUMIDITIES ******************************** +C + INTEGER WFTYP + COMMON /DRH / DRH2SO4, DRNH42S4, DRNAHSO4, DRNACL, DRNANO3, + & DRNA2SO4, DRNH4HS4, DRLC, DRNH4NO3, DRNH4CL + COMMON /MDRH/ DRMLCAB, DRMLCAS, DRMASAN, DRMG1, DRMG2, + & DRMG3, DRMH1, DRMH2, DRMI1, DRMI2, + & DRMI3, DRMQ1, DRMR1, DRMR2, DRMR3, + & DRMR4, DRMR5, DRMR6, DRMR7, DRMR8, + & DRMR9, DRMR10, DRMR11, DRMR12, DRMR13, + & WFTYP +C +C *** VARIABLES FOR LIQUID AEROSOL PHASE ******************************* +C + DOUBLE PRECISION MOLAL, MOLALR, M0 + REAL IONIC + LOGICAL CALAOU, CALAIN, FRST, DRYF + COMMON /IONS/ MOLAL(NIONS), MOLALR(NPAIR), GAMA(NPAIR), ZZ(NPAIR), + & Z(NIONS), GAMOU(NPAIR), GAMIN(NPAIR),M0(NPAIR), + & GASAQ(NGASAQ), + & EPSACT, COH, CHNO3, CHCL, + & WATER, IONIC, IACALC, + & FRST, CALAIN, CALAOU, DRYF +C +C *** VARIABLES FOR SOLID AEROSOL PHASE ******************************** +C + COMMON /SALT/ CH2SO4, CNH42S4, CNH4HS4, CNACL, CNA2SO4, + & CNANO3, CNH4NO3, CNH4CL, CNAHSO4, CLC +C +C *** VARIABLES FOR GAS PHASE ****************************************** +C + COMMON /GAS / GNH3, GHNO3, GHCL +C +C *** EQUILIBRIUM CONSTANTS ******************************************** +C + COMMON /EQUK/ XK1, XK2, XK3, XK4, XK5, XK6, XK7, XK8, XK9, XK10, + & XK11,XK12,XK13,XK14,XKW, XK21,XK22,XK31,XK32,XK41, + & XK42 +C +C *** MOLECULAR WEIGHTS ************************************************ +C + DOUBLE PRECISION IMW + COMMON /OTHR/ R, IMW(NIONS), WMW(NCOMP), SMW(NPAIR) +C +C *** SOLUTION/INFO VARIABLES ****************************************** +C + CHARACTER SCASE*15 + COMMON /CASE/ SULRATW, SULRAT, SODRAT, SCASE +C + COMMON /SOLN/ EPS, MAXIT, NSWEEP, NDIV, ICLACT +C +C *** ERROR SYSTEM ***************************************************** +C + CHARACTER ERRMSG*40 + INTEGER ERRSTK, NOFER + LOGICAL STKOFL + COMMON /EROR/ STKOFL, NOFER, ERRSTK(NERRMX), ERRMSG(NERRMX) +C +C *** GENERIC VARIABLES ************************************************ +C + CHARACTER VERSION*15 + COMMON /CGEN/ GREAT, TINY, TINY2, ZERO, ONE, VERSION +C +C *** END OF INCLUDE FILE ********************************************** +C diff --git a/models/CCTM/aero/blank/opdiam.F b/models/CCTM/aero/blank/opdiam.F new file mode 100755 index 0000000..576590f --- /dev/null +++ b/models/CCTM/aero/blank/opdiam.F @@ -0,0 +1,244 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/opdiam.F,v 1.5 2011/10/21 16:10:15 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE OPDIAM ( JDATE, JTIME, TSTEP ) + +C Revision history +C ??? Frank Binkowski +C 8 Sep 01 J.Young: dyn alloc - Use HGRD_DEFN +C 03 Sep 01 David Wong: for new pario +C 13 May 04 P.Bhave: added RH to species list; removed M0 and dry M2 +C conc's from species list +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C 18 Jul 05 P.Bhave: Added mass fractions of each mode < 2.5um to output list +C 06 Apr 06 P.Bhave: Added GAMMA_N2O5 to output list +C 25 May 06 P.Bhave: Changed units of all DG variables from m to um, as +C suggested by Dr. Bill Hutzell +C 11 Apr 08 J.Kelly: Added STDEVCOR and variables to account for dry & wet +C DGCOR, M2COR_WET, and M3COR_DRY +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN + + USE GRID_CONF ! horizontal & vertical domain specifications + USE UTILIO_DEFN + + IMPLICIT NONE + +! INCLUDE SUBST_HGRD_ID ! horizontal dimensioning parameters +! INCLUDE SUBST_VGRD_ID ! vertical dimensioning parameters + INCLUDE SUBST_FILES_ID ! file name parameters +! INCLUDE SUBST_COORD_ID ! coordinate and domain definitions (req IOPARMS) + +C...Arguments: + + INTEGER JDATE ! current model date, coded YYYYDDD + INTEGER JTIME ! current model time, coded HHMMSS + INTEGER TSTEP ! output time step + +C...Local variables: + + CHARACTER( 16 ), SAVE :: PNAME = 'OPDIAM' + CHARACTER( 96 ) :: XMSG = ' ' + + INTEGER L ! loop induction variables + +C----------------------------------------------------------------------- + +C Try to open existing file for update + + IF ( .NOT. OPEN3( CTM_DIAM_1, FSRDWR3, PNAME ) ) THEN + + XMSG = 'Could not open ' // CTM_DIAM_1 // ' file for update - ' + & // 'try to open new' + CALL M3MESG( XMSG ) + +C Set output file characteristics based on COORD.EXT and open the aerosol +C diagnostic file + + FTYPE3D = GRDDED3 + SDATE3D = JDATE + STIME3D = JTIME + TSTEP3D = TSTEP + CALL NEXTIME ( SDATE3D, STIME3D, TSTEP3D ) ! start the next hour + + NVARS3D = 23 + NCOLS3D = GL_NCOLS + NROWS3D = GL_NROWS + NLAYS3D = NLAYS + 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 = GDNAME_GD + GDNAM3D = GRID_NAME ! from HGRD_DEFN + + VTYPE3D( 1 ) = M3REAL + VNAME3D( 1 ) = 'STDEVATKN' + UNITS3D( 1 ) = ' ' + VDESC3D( 1 ) = 'Aitken mode standard deviation (dry and wet)' + + VTYPE3D( 2 ) = M3REAL + VNAME3D( 2 ) = 'STDEVACC' + UNITS3D( 2 ) = ' ' + VDESC3D( 2 ) = 'Accumulation mode standard deviation (dry and wet)' + + VTYPE3D( 3 ) = M3REAL + VNAME3D( 3 ) = 'STDEVCOR' + UNITS3D( 3 ) = ' ' + VDESC3D( 3 ) = 'Coarse mode standard deviation (dry and wet)' + + VTYPE3D( 4 ) = M3REAL + VNAME3D( 4 ) = 'DGATKN_DRY' + UNITS3D( 4 ) = 'um' + VDESC3D( 4 ) = 'Aitken mode mean diameter (dry)' + + VTYPE3D( 5 ) = M3REAL + VNAME3D( 5 ) = 'DGACC_DRY' + UNITS3D( 5 ) = 'um' + VDESC3D( 5 ) = 'Accumulation mode mean diameter (dry)' + + VTYPE3D( 6 ) = M3REAL + VNAME3D( 6 ) = 'DGCOR_DRY' + UNITS3D( 6 ) = 'um' + VDESC3D( 6 ) = 'Coarse mode mean diameter (dry)' + + VTYPE3D( 7 ) = M3REAL + VNAME3D( 7 ) = 'DGATKN_WET' + UNITS3D( 7 ) = 'um' + VDESC3D( 7 ) = 'Aitken mode mean diameter (wet)' + + VTYPE3D( 8 ) = M3REAL + VNAME3D( 8 ) = 'DGACC_WET' + UNITS3D( 8 ) = 'um' + VDESC3D( 8 ) = 'Accumulation mode mean diameter (wet)' + + VTYPE3D( 9 ) = M3REAL + VNAME3D( 9 ) = 'DGCOR_WET' + UNITS3D( 9 ) = 'um' + VDESC3D( 9 ) = 'Coarse mode mean diameter (wet)' + + VTYPE3D( 10 ) = M3REAL + VNAME3D( 10 ) = 'M2ATKN_WET' + UNITS3D( 10 ) = 'm**2/m**3' + VDESC3D( 10 ) = 'Aitken mode 2nd moment (wet)' + + VTYPE3D( 11 ) = M3REAL + VNAME3D( 11 ) = 'M2ACC_WET' + UNITS3D( 11 ) = 'm**2/m**3' + VDESC3D( 11 ) = 'Accumulation mode 2nd moment (wet)' + + VTYPE3D( 12 ) = M3REAL + VNAME3D( 12 ) = 'M2COR_WET' + UNITS3D( 12 ) = 'm**2/m**3' + VDESC3D( 12 ) = 'Coarse mode 2nd moment (wet)' + + VTYPE3D( 13 ) = M3REAL + VNAME3D( 13 ) = 'M3ATKN_DRY' + UNITS3D( 13 ) = 'm**3/m**3' + VDESC3D( 13 ) = 'Aitken mode 3rd moment (dry)' + + VTYPE3D( 14 ) = M3REAL + VNAME3D( 14 ) = 'M3ACC_DRY' + UNITS3D( 14 ) = 'm**3/m**3' + VDESC3D( 14 ) = 'Accumulation mode 3rd moment (dry)' + + VTYPE3D( 15 ) = M3REAL + VNAME3D( 15 ) = 'M3COR_DRY' + UNITS3D( 15 ) = 'm**3/m**3' + VDESC3D( 15 ) = 'Coarse mode 3rd moment (dry)' + + VTYPE3D( 16 ) = M3REAL + VNAME3D( 16 ) = 'M3ATKN_WET' + UNITS3D( 16 ) = 'm**3/m**3' + VDESC3D( 16 ) = 'Aitken mode 3rd moment (wet)' + + VTYPE3D( 17 ) = M3REAL + VNAME3D( 17 ) = 'M3ACC_WET' + UNITS3D( 17 ) = 'm**3/m**3' + VDESC3D( 17 ) = 'Accumulation mode 3rd moment (wet)' + + VTYPE3D( 18 ) = M3REAL + VNAME3D( 18 ) = 'M3COR_WET' + UNITS3D( 18 ) = 'm**3/m**3' + VDESC3D( 18 ) = 'Coarse mode 3rd moment (wet)' + + VTYPE3D( 19 ) = M3REAL + VNAME3D( 19 ) = 'RH' + UNITS3D( 19 ) = ' ' + VDESC3D( 19 ) = 'Relative humidity' + + VTYPE3D( 20 ) = M3REAL + VNAME3D( 20 ) = 'PM25AT' + UNITS3D( 20 ) = ' ' + VDESC3D( 20 ) = 'Fine fraction of Aitken mode' + + VTYPE3D( 21 ) = M3REAL + VNAME3D( 21 ) = 'PM25AC' + UNITS3D( 21 ) = ' ' + VDESC3D( 21 ) = 'Fine fraction of accumulation mode' + + VTYPE3D( 22 ) = M3REAL + VNAME3D( 22 ) = 'PM25CO' + UNITS3D( 22 ) = ' ' + VDESC3D( 22 ) = 'Fine fraction of coarse mode' + + VTYPE3D( 23 ) = M3REAL + VNAME3D( 23 ) = 'GAMMA_N2O5' + UNITS3D( 23 ) = ' ' + VDESC3D( 23 ) = 'N2O5 Heterogeneous reaction probability' + + FDESC3D( 1 ) = 'aerosol distribution parameters' + DO L = 2, MXDESC3 + FDESC3D( L ) = ' ' + END DO + +C Open the aerosol diagnostic file + + IF ( .NOT. OPEN3( CTM_DIAM_1, FSNEW3, PNAME ) ) THEN + XMSG = 'Could not create '// CTM_DIAM_1 // ' file' + CALL M3EXIT ( PNAME, SDATE3D, STIME3D, XMSG, XSTAT1 ) + END IF + + END IF + + RETURN + END diff --git a/models/CCTM/aero/blank/opvis.F b/models/CCTM/aero/blank/opvis.F new file mode 100755 index 0000000..f5b4e5f --- /dev/null +++ b/models/CCTM/aero/blank/opvis.F @@ -0,0 +1,140 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/opvis.F,v 1.5 2011/10/21 16:10:15 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE OPVIS ( JDATE, JTIME, TSTEP ) + +C Revision history +C ??? Frank Binkowski +C 8 Sep 01 J.Young: dyn alloc - Use HGRD_DEFN +C 03 Sep 01 David Wong: for new pario +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 + + USE GRID_CONF ! horizontal & vertical domain specifications + USE UTILIO_DEFN + + IMPLICIT NONE + +! INCLUDE SUBST_HGRD_ID ! horizontal dimensioning parameters +! INCLUDE SUBST_VGRD_ID ! vertical dimensioning parameters + INCLUDE SUBST_FILES_ID ! file name parameters +! INCLUDE SUBST_COORD_ID ! coordinate and domain definitions (req IOPARMS) + +C...Arguments: + + INTEGER JDATE ! current model date, coded YYYYDDD + INTEGER JTIME ! current model time, coded HHMMSS + INTEGER TSTEP ! output time step + +C...Local variables: + + CHARACTER( 16 ), SAVE :: PNAME = 'OPVIS' + CHARACTER( 96 ) :: XMSG = ' ' + + INTEGER L ! loop induction variables + +C----------------------------------------------------------------------- + +C Try to open existing file for update + + IF ( .NOT. OPEN3( CTM_VIS_1, FSRDWR3, PNAME ) ) THEN + + XMSG = 'Could not open ' // CTM_VIS_1 // ' file for update - ' + & // 'try to open new' + CALL M3MESG( XMSG ) + +C Set output file characteristics based on COORD.EXT and open the dry dep file + + FTYPE3D = GRDDED3 + SDATE3D = JDATE + STIME3D = JTIME + TSTEP3D = TSTEP + CALL NEXTIME ( SDATE3D, STIME3D, TSTEP3D ) ! start the next hour + + NVARS3D = 4 + 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 = GDNAME_GD + GDNAM3D = GRID_NAME ! from HGRD_DEFN + + VTYPE3D( 1 ) = M3REAL + VNAME3D( 1 ) = 'DCV_Mie' + UNITS3D( 1 ) = 'deciview' + VDESC3D( 1 ) = 'hourly visual range' + + VTYPE3D( 2 ) = M3REAL + VNAME3D( 2 ) = 'EXT_Mie' + UNITS3D( 2 ) = '1/km' + VDESC3D( 2 ) = 'hourly extinction coefficient' + + VTYPE3D( 3 ) = M3REAL + VNAME3D( 3 ) = 'DCV_Recon' + UNITS3D( 3 ) = 'deciview' + VDESC3D( 3 ) = 'hourly visual range' + + VTYPE3D( 4 ) = M3REAL + VNAME3D( 4 ) = 'EXT_Recon' + UNITS3D( 4 ) = '1/km' + VDESC3D( 4 ) = 'hourly extinction coefficient' + + FDESC3D( 1 ) = 'hourly 1-layer cross-point Visibility Information' + DO L = 2, MXDESC3 + FDESC3D( L ) = ' ' + END DO + +C Open visibility file new + + IF ( .NOT. OPEN3( CTM_VIS_1, FSNEW3, PNAME ) ) THEN + XMSG = 'Could not create '// CTM_VIS_1 // ' file' + CALL M3EXIT( PNAME, SDATE3D, STIME3D, XMSG, XSTAT1 ) + END IF + + END IF + + RETURN + END diff --git a/models/CCTM/aero/blank/poaage.F b/models/CCTM/aero/blank/poaage.F new file mode 100755 index 0000000..fef7efb --- /dev/null +++ b/models/CCTM/aero/blank/poaage.F @@ -0,0 +1,220 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/aero/aero5/poaage.F,v 1.5 2011/11/03 18:41:14 sjr Exp $ + + + + +!C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE POAAGE( DT ) + + +!C ##################################################################### +!C This subroutine calculates oxidative aging of POA using the +!C following reaction: +!C POCRm ---> PNCOM (rate constant = koheff*[OH]) +!C - koheff comes from Weitkamp et al (2008) and George et al (2007) +!C - POCRm = reduced primary organic carbon (molar concentration) +!C +!C POMOC = (POC + NCOM)/POC +!C - in other words: pimary OM/OC = (POC + PNCOM)/POC +!C PHOrat = (44/12 - POMOC)/(POMOC - 14/12) +!C - see Simon et al. (2011) for derivation +!C Omoles = NCOM/(16 + PHOrat) if POMOC is between 14/12 and 44/12 +!C - see Simon et al (2011) for derivation +!C Omoles = NCOM/16 for POMOC larger than 44/12 +!C - if OM/OC > 3.667, then POC is fully oxidized and all +!C NCOM is oxygen +!C Omoles = 0 for POMOC smaller than 14/12 +!C - if OM/OC < 1.167, then POC is fully reduced and all +!C NCOM is hydrogen +!C +!C POCRm = POC/12 - Omoles +!C note:we divide POC by 12 b/c we want moles of carbon atoms not moles +!C of POC (since each carbon atom w\in the molecule is allowed +!C to react) +!C note: we calculate Omoles based on the equations above derived from +!C Heald et al (2010) and documented in Simon et al (2011). +!C +!C The following rate equation comes from the reaction above: +!C dPOCRm/dt = POCRm*koheff*[OH] +!C -assume that [OH] does not change as a result of this reaction +!C solve for POCRm at time, t +!C moles: POCRm(t) = POCRm(0)*EXP(-koheff*[OH]*t) = POCRm(0)*expdt +!C +!C One mole of "NCOMm" is formed for every mole of POCRm that reacts: +!C -dPOCRm/dt = dNCOMm/det +!C moles of NCOMm: NCOMm = NCOMm(0) + POCRm(0)*[1-EXP(-koheff*[OH]*t)] = +!C NCOMm(0) + POCRm(0)*(1-expdt) +!C NCOMg = NCOMm*15.0 +!C - every mole of newly formed NCOM results in an average gain of 1 oxygen atom +!C and an average loss of 1 hydrogen atoms (on average, two oxidation steps +!C convert a CH3 functional group into a COOH functional group) +!C -(based on Heald et al. (2010)) +!C Rewrite NCOM formation equation using grams: +!C NCOMg/15.0 = NCOMg(0)/15.0 + POCRm*(1-expdt) +!C | +!C | +!C V +!C NCOMg == NCOM(0) + 15.0*POCRm*(1-expdt) +!C +!C ##################################################################### +!C +!C +!C +!c Key Subroutines Called: none +!c +!c Key Functions Called: none +!c +!c Revision History: +!c First version was coded in February 2011 by Dr. Heather Simon +!C +!c REFERENCES: +!c 1. George, I.J., Vlasenko, A., Slowik, J.G., Broekhuizen, K., +!C Abbatt, J.P.D. (2007), Heterogeneous oxidation of saturated +!C organic aerosols by hydroxyl radicals: uptake kinetics, +!C condesned-phase products, and particle size change, +!C Atmospheric Chemistry and Physics, 7, 4187-4201 +!c +!c 2. Heald, C.L., Kroll, J.H., Jimenez, J.L., Docherty, K.S., +!C DeCarlo, P.F., Aiken, A.C., Chen, Q., Martin, S.T., Farmer, S.T., +!C Artaxo, P. (2010), A simplified description of the evolution of +!C organic aerosol composition in the atmosphere, GRL, 37, L08803. +!C +!C 3. Simon, H. and Bhave, P.V. (2011), Simulating the degree of oxidation +!C in atmospheric organic particles +!C In Review at ES&T. +!C +!C 4. Weitkamp, E.A., Lambe, A.T., Donahue, N.M., Robinson, A.L. (2008), +!C Laboratory measurements of the heterogeneous oxidation of condensed- +!C phase organic molecular markers for motor vehicl exhaust, 42, +!C 7950-7956. +!c +!C----------------------------------------------------------------------- + + USE AERO_DATA + USE PRECURSOR_DATA + + IMPLICIT NONE + + INCLUDE SUBST_RXCMMN ! to get mech name + +!C *** Arguments + REAL, INTENT( IN ) :: DT ! Synchronization time step + +!C *** Parameters + REAL, PARAMETER :: koheff = 0.25E-11 ! effective OH rate constant in cm3 molec-1 sec-1 + REAL, PARAMETER :: Avogadro= 6.02214179E23 ! Avogadro's number + +!C *** Local Variables + +!C * chemical species concentrations + REAL POCRmi ! aitken mode moles of reduced primary carbon calculated as + ! moles of POC carbon minus moles of NCOM oxygen (POC/12- moles of O) + REAL POCRmj ! accumulation mode moles of reduced primary carbon calculated as + ! moles of POC carbon minus moles of NCOM oxygen (POC/12- moles of O) + REAL OHmoleccm3 ! OH concentrations in molec/cm3 + REAL Omolesi ! moles of Oxygen in aitken mode primary OA + REAL Omolesj ! moles of Oxygen in accumulation mode primary OA + + +!C * variables representing mass and molar ratios + REAL POMOCi ! OM/OC ratio in aitken mode primary OA + REAL POMOCj ! OM/OC ratio in accumulation mode primary OA + REAL PHOrati ! H/O molar ratio in aitken mode primary OA + REAL PHOratj ! H/O molar ratio in accumulation mode primary OA + +!C * + REAL expdt_POC ! non-dimensional loss coefficient + +!C----------------------------------------------------------------------- + +!C POA aging is enabled in aero6 + IF ( INDEX ( MECHNAME, 'AE5' ) .GT. 0 ) RETURN + +!C calculate OM/OC and H/O ratios + +!C Aitken mode + IF (aerospc_conc(APOC_IDX,1) .NE. 0.0) THEN + POMOCi = (aerospc_conc(APOC_IDX,1) + aerospc_conc(APNCOM_IDX,1))/aerospc_conc(APOC_IDX,1) + ELSE + POMOCi = 0 ! If POC is 0, then the value of POMOC does not matter b/c POCR will also be 0 + END IF + +!C Accumulation mode + IF (aerospc_conc(APOC_IDX,2) .NE. 0.0) THEN + POMOCj = (aerospc_conc(APOC_IDX,2) + aerospc_conc(APNCOM_IDX,2))/aerospc_conc(APOC_IDX,2) + ELSE + POMOCj = 0 ! If POC is 0, then the value of POMOC does not matter b/c POCR will also be 0 + END IF + + PHOrati = 0.0 + PHOratj = 0.0 + +!C Aitken mode + IF (POMOCi .LE. (14.0/12.0)) THEN + Omolesi = 0.0 + ELSE IF (POMOCi .GE. (44.0/12.0)) THEN + Omolesi = (aerospc_conc(APNCOM_IDX,1))/16.0 + ELSE IF ((POMOCi .LT. (44.0/12.0)) .AND. + &(POMOCi .GT. (14.0/12.0)) ) THEN + PHOrati = ((44.0/12.0)-POMOCi)/(POMOCi-(14.0/12.0)) + Omolesi = (aerospc_conc(APNCOM_IDX,1))/(16.0 + PHOrati) + END IF + +!C Accumulation mode + IF (POMOCj .LE. (14.0/12.0)) THEN + Omolesj = 0.0 + ELSE IF (POMOCj .GE. (44.0/12.0)) THEN + Omolesj = (aerospc_conc(APNCOM_IDX,2))/16.0 + ELSE IF ((POMOCj .LT. (44.0/12.0)) .AND. + &(POMOCj .GT. (14.0/12.0)) ) THEN + PHOratj = ((44.0/12.0)-POMOCj)/(POMOCj-(14.0/12.0)) + Omolesj = (aerospc_conc(APNCOM_IDX,2))/(16.0 + PHOratj) + END IF + +!C calculate POCR + POCRmi = (aerospc_conc(APOC_IDX,1))/12.0 - Omolesi + POCRmj = (aerospc_conc(APOC_IDX,2))/12.0 - Omolesj + + POCRmi = max(POCRmi, 0.0) + POCRmj = max(POCRmj, 0.0) + +!C convert OH to molecules/cm3 + + OHmoleccm3 = precursor_conc(OH_IDX) * 1.0E-12 * Avogadro / precursor_mw(OH_IDX) + + +!C calculate expdt + + expdt_POC = exp( - koheff* OHmoleccm3 * DT ) + +!C calculate new NCOM concentrations + + aerospc_conc(APNCOM_IDX,1) = aerospc_conc(APNCOM_IDX,1) + 15.0 * POCRmi * ( 1.0 - expdt_POC) + aerospc_conc(APNCOM_IDX,2) = aerospc_conc(APNCOM_IDX,2) + 15.0 * POCRmj * ( 1.0 - expdt_POC) + + + RETURN + + END SUBROUTINE POAAGE + + diff --git a/models/CCTM/cloud/blank/cldproc_acm.F b/models/CCTM/cloud/blank/cldproc_acm.F new file mode 100755 index 0000000..b63e346 --- /dev/null +++ b/models/CCTM/cloud/blank/cldproc_acm.F @@ -0,0 +1,166 @@ + +!------------------------------------------------------------------------! +! 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/cloud/cloud_acm_ae6/cldproc_acm.F,v 1.6 2011/10/21 16:10:23 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE CLDPROC ( CGRID, JDATE, JTIME, TSTEP ) + +C----------------------------------------------------------------------- +C +C FUNCTION: RADM/ACM and Resolved cloud process driver +C +C PRECONDITIONS REQUIRED: +C Dates and times represented YYYYDDD:HHMMSS. +C +C REVISION HISTORY: +C Date Who What +C -------- --- ----------------------------------------- +C 11/21/00 J. Young enable appending timesteps to wetdep1 and wetdep2 +C 3/01/98 S.Roselle modified to output 2 wet deposition files +C 8/12/97 S.Roselle added conversion of cgrid units to mol/mol units +C 6/14/94 Dongming Hwang configuration management prototype +C Dec 00 J. Young move CGRID_MAP into f90 module +C Sep 01 J. Young Dyn Alloc - Use HGRD_DEFN +C Jan 05 J. Young dyn alloc - establish both horizontal & vertical +C domain specifications in one module +C May 05 J. Pleim Replaced RADMcld with RADMacmcld +C 6/08/05 S.Roselle added new cloud diagnostic variables +C 7/21/09 D. Wong fixed parallel bug in opening WET_DEP_2 +C Oct 10 J.Young convert for Namelist redesign +C 3/01/11 S.Roselle replaced I/O API include files with UTILIO_DEFN +C 5/11/11 D.Wong: incorporated twoway model implementation +C 02Aug12 S.Roselle: instrumented to output transmissivity for +C convective and resolved clouds + +C----------------------------------------------------------------------- + + USE GRID_CONF ! horizontal & vertical domain specifications + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + + IMPLICIT NONE + +C...........INCLUDES + + INCLUDE SUBST_CONST ! constants + INCLUDE SUBST_FILES_ID ! file name parameters + + CHARACTER( 120 ) :: XMSG = ' ' ! exit status message string + +C...........PARAMETERS + +C # of wet deposition species + INTEGER, SAVE :: N_SPC_WDEP + + REAL, PARAMETER :: CNV1 = MWAIR * 1.0E-9 + REAL, PARAMETER :: CNV1I = 1.0 / CNV1 + REAL, PARAMETER :: CNV2 = MWAIR * 1.0E-3 + REAL, PARAMETER :: CNV2I = 1.0 / CNV2 +! REAL, PARAMETER :: CNV3 = MWAIR * 1.0E+3 / AVO ! -> ppmV +! REAL, PARAMETER :: CNV3 = CNV2 / AVO ! -> mol/mol + REAL, PARAMETER :: CNV3 = CNV2 ! -> #/mol + REAL, PARAMETER :: CNV3I = 1.0 / CNV3 + +C...........ARGUMENTS + +! REAL CGRID( NCOLS, NROWS, NLAYS, * ) ! concentrations +! REAL :: CGRID( :,:,:,: ) ! concentrations + REAL, POINTER :: CGRID( :,:,:,: ) ! concentrations + INTEGER JDATE ! current model date, coded YYYYDDD + INTEGER JTIME ! current model time, coded HHMMSS + INTEGER TSTEP( 3 ) ! model time step, coded HHMMSS + +C...........Local Variables + + LOGICAL, SAVE :: FIRSTIME = .TRUE. ! flag for first pass thru + + LOGICAL, SAVE :: CLD_DIAG ! flag to output cloud diagnostic files + + CHARACTER( 16 ), SAVE :: PNAME = 'CLDPROC' ! driver program name + CHARACTER( 16 ) :: VNAME ! input variable name list + + INTEGER COL ! column subscript indices + INTEGER FINI ! ending position + INTEGER ICLDTYPE ! 1: raining, 2: either CNP or PFW + INTEGER L ! loop counter + INTEGER LAY ! layer subscript indices + INTEGER MDATE ! middle of this time step + INTEGER MTIME ! middle of this time step + INTEGER NDATE ! middle of this time step + INTEGER NTIME ! middle of this time step + INTEGER, SAVE :: NNAE ! number of #/m3 species + INTEGER, SAVE :: NQAE ! number of ug/m3 species + INTEGER, SAVE :: NSAE ! number of m2/m3 species + INTEGER ROW ! row subscript indices + INTEGER SPC ! species subscript indices + INTEGER STRT ! starting position + INTEGER STATUS ! ENVINT status + INTEGER VAR ! variable subscript indices + INTEGER ALLOCSTAT + INTEGER, ALLOCATABLE, SAVE :: WDEP_MAP( : ) ! wet deposition map to CGRID + INTEGER, ALLOCATABLE, SAVE :: QAE( : ) ! CGRID pointer to ug/m3 species + INTEGER, ALLOCATABLE, SAVE :: NAE( : ) ! CGRID pointer to #/m3 species + INTEGER, ALLOCATABLE, SAVE :: SAE( : ) ! CGRID pointer to m2/m3 species + + INTEGER, SAVE :: LOGDEV ! output log unit number + + +! REAL DENS ( NCOLS,NROWS,NLAYS ) ! air density (kg/m3) +! REAL CONV_DEP( NCOLS,NROWS,N_SPC_WDEP+8 ) ! convective wdep only +! REAL TOT_DEP ( NCOLS,NROWS,N_SPC_WDEP+1 ) ! total wdep + REAL, ALLOCATABLE, SAVE :: DENS ( :,:,: ) ! air density (kg/m3) + REAL, ALLOCATABLE, SAVE :: CONV_DEP( :,:,: ) ! convective wdep only + REAL, ALLOCATABLE, SAVE :: TOT_DEP ( :,:,: ) ! total wdep + REAL, ALLOCATABLE, SAVE :: RESTRANS( :,: ) + REAL, ALLOCATABLE, SAVE :: SUBTRANS( :,:,: ) + + REAL FAC ! temp conversion factor + REAL CCMIN + + INTEGER GXOFF, GYOFF ! global origin offset from file +C for INTERPX + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + +C...........EXTERNAL FUNCTIONS + +C----------------------------------------------------------------------- +C begin body of subroutine CLDPROC + +C...Initialization + + IF ( FIRSTIME ) THEN + LOGDEV = INIT3() + FIRSTIME = .FALSE. + +C...first check to make sure that some species in CGRID were specified +C...for output in the wet deposition array, otherwise notify the user +C...and return + + END IF ! FIRSTIME + + + RETURN + + END diff --git a/models/CCTM/cloud/blank/hlconst.F b/models/CCTM/cloud/blank/hlconst.F new file mode 100755 index 0000000..985af07 --- /dev/null +++ b/models/CCTM/cloud/blank/hlconst.F @@ -0,0 +1,439 @@ + +!------------------------------------------------------------------------! +! 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$ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + REAL FUNCTION HLCONST ( CNAME, TEMP, EFFECTIVE, HPLUS ) + +C----------------------------------------------------------------------- +C +C FUNCTION: return the Henry's law constant for the specified substance +C at the given temperature +C +C revision history: +C who when what +C --------- -------- ------------------------------------- +C S.Roselle 08/15/97 code written for Models-3 +C J.Gipson 06/18/01 added Henry's Law constants 50-55 for saprc99 +C W.Hutzell 07/03/01 added Henry's Law constants 56-57 for Atrazine +C and the daughter products from Atrazine and OH +C reactions. +C J.Gipson. 09/06/02 added Henry's Law constants 59-73 for toxics +C S.Roselle 11/07/02 added capability for calculating the effective +C Henry's law constant and updated coefficients +C in Henry's law constant table +C J.Gipson 08/06/03 added Henry's Law constants 77-79 +C G.Sarwar 11/21/04 added constants for chlorine chemistry (Henry's +C law constants 80-85 and dissociation constants +C 14-16 +C R.Bullock 07/05/05 added Henry's Law constants 86-87 for mercury +C with enthalpy calculated from cited laboratory +C data fit to an Arrhenius equation +C W.Hutzell 02/14/06 added HLC 88 to 116, dissociation constant for +C 17 (hydrazine) +C A.Carlton 09/20/06 updated Henry's Law constants for 1,7,19,20,21,30 +C O3, NO3, hexane, octane, nonane, methanol and +C isoprene reference +C S.Roselle 10/10/07 changed pointers to parameters; reformatted +C variable declarations +C W.Hutzell 03/07/08 added Henry's Law constants for 117 to 120 +C W.Hutzell 01/01/09 added Henry's Law constants for 121 to 125 for +C for SAPRC07T mechanism +C Y.Xie 6/11/10 added Henry's Law constants for 126 to 130 for +C isoprene chemistry in SAPRC07 +C W.Hutzell 08/16/12 updated IOAPI and Henry Constant names to V5.01 +C standards +C W.Hutzell 01/30/13 updated PHENOL, and add values for CATECHOL and +C XYLENOL +C G.Sarwar 12/18/13 added Henry's Law constants for 133 to 138 +C----------------------------------------------------------------------- + + USE UTILIO_DEFN + + IMPLICIT NONE + +C...........INCLUDES and their descriptions + + +C...........PARAMETERS and their descriptions: + + INTEGER, PARAMETER :: MXSPCS = 138 ! Number of substances + INTEGER, PARAMETER :: MXDSPCS = 17 ! Number of dissociating species + +C...pointers for the dissociation constants (array B and D) + + INTEGER, PARAMETER :: LSO2 = 1 ! SO2 + INTEGER, PARAMETER :: LHSO3 = 2 ! HSO3 + INTEGER, PARAMETER :: LHNO2 = 3 ! HNO3 + INTEGER, PARAMETER :: LHNO3 = 4 ! HNO3 + INTEGER, PARAMETER :: LCO2 = 5 ! CO2 + INTEGER, PARAMETER :: LHCO3 = 6 ! HCO3 + INTEGER, PARAMETER :: LH2O2 = 7 ! H2O2 + INTEGER, PARAMETER :: LHCHO = 8 ! HCHO + INTEGER, PARAMETER :: LHCOOH = 9 ! HCOOH + INTEGER, PARAMETER :: LHO2 = 10 ! HO2 + INTEGER, PARAMETER :: LNH4OH = 11 ! NH4OH + INTEGER, PARAMETER :: LH2O = 12 ! H2O + INTEGER, PARAMETER :: LATRA = 13 ! Atrazine + INTEGER, PARAMETER :: LCL2 = 14 ! CL2 + INTEGER, PARAMETER :: LHOCL = 15 ! HOCL + INTEGER, PARAMETER :: LHCL = 16 ! HCL + INTEGER, PARAMETER :: LHYDRAZINE = 17 ! Hydrazine + +C...........ARGUMENTS and their descriptions + + CHARACTER*(*) CNAME ! name of substance + REAL TEMP ! temperature (K) + LOGICAL EFFECTIVE ! true=compute the effective henry's law constant + REAL HPLUS ! hydrogen ion concentration (mol/l) + +C...........SCRATCH LOCAL VARIABLES and their descriptions: + + CHARACTER( 16 ), SAVE :: PNAME = 'HLCONST' ! program name + CHARACTER( 16 ), SAVE :: SUBNAME( MXSPCS ) ! list of substance names + + CHARACTER( 120 ) :: XMSG = ' ' ! exit status message string + + INTEGER SPC ! species index + + REAL HPLUSI ! 1 / HPLUS + REAL HPLUS2I ! 1 / HPLUS**2 + REAL CLMINUS ! chlorine ion conc [CL-] + REAL CLMINUSI ! 1 / CLMINUS + REAL TFAC ! (298-T)/(T*298) + REAL AKEQ1 ! temp var for dissociation constant + REAL AKEQ2 ! temp var for dissociation constant + REAL OHION ! OH ion concentration + REAL KH ! temp var for henry's law constant + +C...Henry's law constant data taken mostly from Rolf Sanders' Compilation of +C... Henry's Law Constants for Inorganic and Organic Species of Potential +C... Importance in Environment Chemistry 1999 + + REAL, SAVE :: A( MXSPCS ) ! Henry's law constants at 298.15K (M/atm) + REAL, SAVE :: E( MXSPCS ) ! enthalpy (like activation energy) (K) + +C...dissociation constant data taken mostly from 6.A.1 of Seinfeld and Pandis +C... Atmospheric Chemistry and Physics, 1997 + + REAL, SAVE :: B( MXDSPCS ) ! dissociation constant at 298.15K (M or M2) + REAL, SAVE :: D( MXDSPCS ) ! -dH/R (K) + + DATA SUBNAME( 1), A( 1), E( 1) / 'O3 ', 1.14E-02, 2.3E+03 / ! Kosak 1983 + DATA SUBNAME( 2), A( 2), E( 2) / 'HO2 ', 4.0E+03, 5.9E+03 / ! Hanson et al. 1992 + DATA SUBNAME( 3), A( 3), E( 3) / 'H2O2 ', 8.3E+04, 7.4E+03 / ! O'Sullivan et al. 1996 + DATA SUBNAME( 4), A( 4), E( 4) / 'NH3 ', 6.1E+01, 4.2E+03 / ! Clegg and Brimblecombe 1989 + DATA SUBNAME( 5), A( 5), E( 5) / 'NO ', 1.9E-03, 1.4E+03 / ! Lide and Frederikse 1995 + DATA SUBNAME( 6), A( 6), E( 6) / 'NO2 ', 1.2E-02, 2.5E+03 / ! Chameides 1984 + DATA SUBNAME( 7), A( 7), E( 7) / 'NO3 ', 0.6E+00, 0.0E+00 / ! Rudich, Talukdar et al.1996 + DATA SUBNAME( 8), A( 8), E( 8) / 'N2O5 ', 1.0E+30, 0.0E+00 / ! "inf" Sander and Crutzen 1996 + DATA SUBNAME( 9), A( 9), E( 9) / 'HNO2 ', 5.0E+01, 4.9E+03 / ! Becker et al. 1996 + DATA SUBNAME( 10), A( 10), E( 10) / 'HNO3 ', 2.1E+05, 8.7E+03 / ! Leieveld and Crutzen 1991 + DATA SUBNAME( 11), A( 11), E( 11) / 'HNO4 ', 1.2E+04, 6.9E+03 / ! Regimbal and Mozurkewich 1997 + DATA SUBNAME( 12), A( 12), E( 12) / 'SO2 ', 1.4E+00, 2.9E+03 / ! Linde and Frederikse 1995 + DATA SUBNAME( 13), A( 13), E( 13) / 'H2SO4 ', 1.0E+30, 0.0E+00 / ! infinity + DATA SUBNAME( 14), A( 14), E( 14) / 'METHANE ', 1.4E-03, 1.6E+03 / ! Linde and Frederikse 1995 + DATA SUBNAME( 15), A( 15), E( 15) / 'ETHANE ', 1.9E-03, 2.3E+03 / ! Linde and Frederikse 1995 + DATA SUBNAME( 16), A( 16), E( 16) / 'PROPANE ', 1.5E-03, 2.7E+03 / ! Linde and Frederikse 1995 + DATA SUBNAME( 17), A( 17), E( 17) / 'BUTANE ', 1.1E-03, 0.0E+00 / ! Mackay and Shiu 1981 + DATA SUBNAME( 18), A( 18), E( 18) / 'PENTANE ', 8.1E-04, 0.0E+00 / ! Mackay and Shiu 1981 + DATA SUBNAME( 19), A( 19), E( 19) / 'HEXANE ', 0.1E-03, 7.5E+03 / ! Ashworth, Howe et al 1988 + DATA SUBNAME( 20), A( 20), E( 20) / 'OCTANE ', 2.9E-03, 7.8E+03 / ! Hansen et al. 1993 + DATA SUBNAME( 21), A( 21), E( 21) / 'NONANE ', 2.4E-03, 2.1E+02 / ! Ashworth, Howe et al 1988 + DATA SUBNAME( 22), A( 22), E( 22) / 'DECANE ', 1.4E-04, 0.0E+00 / ! Mackay and Shiu 1981 + DATA SUBNAME( 23), A( 23), E( 23) / 'ETHENE ', 4.7E-03, 0.0E+00 / ! Mackay and Shiu 1981 + DATA SUBNAME( 24), A( 24), E( 24) / 'PROPENE ', 4.8E-03, 0.0E+00 / ! Mackay and Shiu 1981 + DATA SUBNAME( 25), A( 25), E( 25) / 'ISOPRENE ', 2.8E-02, 0.0E+00 / ! Karl, Lindinger et al 2003 + DATA SUBNAME( 26), A( 26), E( 26) / 'ACETYLENE ', 4.1E-02, 1.8E+03 / ! Wilhelm et al. 1977 + DATA SUBNAME( 27), A( 27), E( 27) / 'BENZENE ', 1.6E-01, 4.1E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 28), A( 28), E( 28) / 'TOLUENE ', 1.5E-01, 4.0E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 29), A( 29), E( 29) / 'O-XYLENE ', 1.9E-01, 4.0E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 30), A( 30), E( 30) / 'METHANOL ', 2.2E+02, 5.2E+03 / ! Snider and Dawson 1985 + DATA SUBNAME( 31), A( 31), E( 31) / 'ETHANOL ', 1.9E+02, 6.6E+03 / ! Snider and Dawson 1985 + DATA SUBNAME( 32), A( 32), E( 32) / '2-CRESOL ', 8.2E+02, 0.0E+00 / ! Betterton 1992 + DATA SUBNAME( 33), A( 33), E( 33) / '4-CRESOL ', 1.3E+02, 0.0E+00 / ! Betterton 1992 + DATA SUBNAME( 34), A( 34), E( 34) / 'METHYLHYDROPEROX', 3.1E+02, 5.2E+03 / ! O'Sullivan et al. 1996 + DATA SUBNAME( 35), A( 35), E( 35) / 'FORMALDEHYDE ', 3.2E+03, 6.8E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 36), A( 36), E( 36) / 'ACETALDEHYDE ', 1.4E+01, 5.6E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 37), A( 37), E( 37) / 'GENERIC_ALDEHYDE', 4.2E+03, 0.0E+00 / ! Graedel and Goldberg 1983 + DATA SUBNAME( 38), A( 38), E( 38) / 'GLYOXAL ', 3.6E+05, 0.0E+00 / ! Zhou and Mopper 1990 + DATA SUBNAME( 39), A( 39), E( 39) / 'ACETONE ', 3.0E+01, 4.6E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 40), A( 40), E( 40) / 'FORMIC_ACID ', 8.9E+03, 6.1E+03 / ! Johnson et al. 1996 + DATA SUBNAME( 41), A( 41), E( 41) / 'ACETIC_ACID ', 4.1E+03, 6.3E+03 / ! Johnson et al. 1996 + DATA SUBNAME( 42), A( 42), E( 42) / 'METHYL_GLYOXAL ', 3.2E+04, 0.0E+00 / ! Zhou and Mopper 1990 + DATA SUBNAME( 43), A( 43), E( 43) / 'CO ', 9.9E-04, 1.3E+03 / ! Linde and Frederikse 1995 + DATA SUBNAME( 44), A( 44), E( 44) / 'CO2 ', 3.6E-02, 2.2E+03 / ! Zheng et al. 1997 + DATA SUBNAME( 45), A( 45), E( 45) / 'PAN ', 2.8E+00, 6.5E+03 / ! Kames et al. 1991 + DATA SUBNAME( 46), A( 46), E( 46) / 'MPAN ', 1.7E+00, 0.0E+00 / ! Kames and Schurath 1995 + DATA SUBNAME( 47), A( 47), E( 47) / 'OH ', 3.0E+01, 4.5E+03 / ! Hanson et al. 1992 + DATA SUBNAME( 48), A( 48), E( 48) / 'METHYLPEROXY_RAD', 2.0E+03, 6.6E+03 / ! Lelieveld and Crutzen 1991 + DATA SUBNAME( 49), A( 49), E( 49) / 'PEROXYACETIC_ACI', 8.4E+02, 5.3E+03 / ! O'Sullivan et al. 1996 + DATA SUBNAME( 50), A( 50), E( 50) / 'PROPANOIC_ACID ', 5.7E+03, 0.0E+00 / ! Kahn et al. 1995 + DATA SUBNAME( 51), A( 51), E( 51) / '2-NITROPHENOL ', 7.0E+01, 4.6E+03 / ! USEPA 1982 + DATA SUBNAME( 52), A( 52), E( 52) / 'PHENOL ', 3.3E+03, 3.6E+03 / ! Meylan and Howard (1991) + DATA SUBNAME( 53), A( 53), E( 53) / 'BIACETYL ', 7.4E+01, 5.7E+03 / ! Betteron 1991 + DATA SUBNAME( 54), A( 54), E( 54) / 'BENZALDEHYDE ', 3.9E+01, 4.8E+03 / ! Staudinger and Roberts 1996 + DATA SUBNAME( 55), A( 55), E( 55) / 'PINENE ', 4.9E-02, 0.0E+00 / ! Karl and Lindinger 1997 + DATA SUBNAME( 56), A( 56), E( 56) / 'ATRA ', 4.1E+05, 6.0E+03 / ! CIBA Corp (1989) and Scholtz (1999) + DATA SUBNAME( 57), A( 57), E( 57) / 'DATRA ', 4.1E+05, 6.0E+03 / ! assumed same as Atrazine + DATA SUBNAME( 58), A( 58), E( 58) / 'ADIPIC_ACID ', 2.0E+08, 0.0E+00 / ! Saxena and Hildemann (1996) + DATA SUBNAME( 59), A( 59), E( 59) / 'ACROLEIN ', 8.2E+00, 0.0E+00 / ! Meylan and Howard (1991) + DATA SUBNAME( 60), A( 60), E( 60) / '13-BUTADIENE ', 1.4E-02, 0.0E+00 / ! Mackay and Shiu (1981) + DATA SUBNAME( 61), A( 61), E( 61) / 'ACRYLONITRILE ', 7.3E+00, 0.0E+00 / ! Meylan and Howard (1991) + DATA SUBNAME( 62), A( 62), E( 62) / 'CARBONTETRACHLOR', 3.4E-02, 4.2E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 63), A( 63), E( 63) / 'PROPYLENE_DICHLO', 3.4E-01, 4.3E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 64), A( 64), E( 64) / '13DICHLOROPROPEN', 6.5E-01, 4.2E+03 / ! Wright et al (1992b) + DATA SUBNAME( 65), A( 65), E( 65) / '1122-CL4ETHANE ', 2.4E+00, 3.2E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 66), A( 66), E( 66) / 'CHLOROFORM ', 2.5E-01, 4.5E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 67), A( 67), E( 67) / '12DIBROMOETHANE ', 1.5E+00, 3.9E+03 / ! Ashworth et al (1988) + DATA SUBNAME( 68), A( 68), E( 68) / '12DICHLOROETHANE', 7.3E-01, 4.2E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 69), A( 69), E( 69) / 'METHYLENE_CHLORI', 3.6E-01, 4.1E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 70), A( 70), E( 70) / 'PERCHLOROETHYLEN', 5.9E-02, 4.8E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 71), A( 71), E( 71) / 'TRICHLOROETHENE ', 1.0E-01, 4.6E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 72), A( 72), E( 72) / 'VINYL_CHLORIDE ', 3.9E-02, 3.1E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME( 73), A( 73), E( 73) / 'ETHYLENE_OXIDE ', 8.4E+00, 0.0E+00 / ! CRC + DATA SUBNAME( 74), A( 74), E( 74) / 'PPN ', 2.9E+00, 0.0E+00 / ! Kames and Schurath (1995) + DATA SUBNAME( 75), A( 75), E( 75) / 'NAPHTHALENE ', 2.0E+00, 3.6E+03 / ! USEPA 1982 + DATA SUBNAME( 76), A( 76), E( 76) / 'QUINOLINE ', 3.7E+03, 5.4E+03 / ! USEPA 1982 + DATA SUBNAME( 77), A( 77), E( 77) / 'MEK ', 2.0E+01, 5.0E+03 / ! Zhou and Mopper 1990 + DATA SUBNAME( 78), A( 78), E( 78) / 'MVK ', 4.1E+01, 0.0E+00 / ! Iraci et al. 1998 + DATA SUBNAME( 79), A( 79), E( 79) / 'METHACROLEIN ', 6.5E+00, 0.0E+00 / ! Iraci et al. 1998 + DATA SUBNAME( 80), A( 80), E( 80) / 'CL2 ', 8.6E-02, 2.0E+03 / ! ROLF SANDERS COMPILATION (1999)/KAVANAUGH AND TRUSSELL (1980) + DATA SUBNAME( 81), A( 81), E( 81) / 'HOCL ', 6.6E+02, 5.9E+03 / ! ROLF SANDERS COMPILATION (1999)/HUTHWELKER ET AL (1995) + DATA SUBNAME( 82), A( 82), E( 82) / 'HCL ', 1.9E+01, 6.0E+02 / ! ROLF SANDERS COMPILATION (1999)/DEAN (1992) + DATA SUBNAME( 83), A( 83), E( 83) / 'FMCL ', 1.1E+00, 0.0E+00 / ! EPA SUITE PROGRAM/UNIT CONVERTED TO MATCH THE DEFINITION BY ROLF SANDERS. + DATA SUBNAME( 84), A( 84), E( 84) / 'ICL1 ', 6.9E+01, 0.0E+00 / ! EPA SUITE PROGRAM/UNIT CONVERTED TO MATCH THE DEFINITION BY ROLF SANDERS. + DATA SUBNAME( 85), A( 85), E( 85) / 'ICL2 ', 6.9E+01, 0.0E+00 / ! EPA SUITE PROGRAM/ASSUMED EQUAL TO THAT OF ICL1 + DATA SUBNAME( 86), A( 86), E( 86) / 'HG ', 1.11E-01, 4.97E+03 /! Elemental Mercury from Clever et al. (1985) + DATA SUBNAME( 87), A( 87), E( 87) / 'HGIIGAS ', 1.41E+06, 5.26E+03 /! Hg(II) gas as mercuric chloride from Lindqvist and Rodhe (1985) + DATA SUBNAME( 88), A( 88), E( 88) / 'TECDD_2378 ', 5.1E+00, 3.6E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 89), A( 89), E( 89) / 'PECDD_12378 ', 4.6E+00, 3.2E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 90), A( 90), E( 90) / 'HXCDD_123478 ', 8.1E+00, 2.9E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 91), A( 91), E( 91) / 'HXCDD_123678 ', 2.9E+00, 2.8E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 92), A( 92), E( 92) / 'HXCDD_123789 ', 6.5E+00, 2.7E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 93), A( 93), E( 93) / 'HPCDD_1234678 ', 1.2E+01, 2.4E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 94), A( 94), E( 94) / 'OTCDD ', 9.8E+00, 2.3E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 95), A( 95), E( 95) / 'TECDF_2378 ', 8.5E+01, 3.7E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 96), A( 96), E( 96) / 'PECDF_12378 ', 5.2E+01, 2.9E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 97), A( 97), E( 97) / 'PECDF_23478 ', 1.8E+02, 3.0E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 98), A( 98), E( 98) / 'HXCDF_123478 ', 3.8E+01, 2.4E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME( 99), A( 99), E( 99) / 'HXCDF_123678 ', 9.0E+01, 2.9E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME(100), A(100), E(100) / 'HXCDF_234678 ', 1.0E+02, 2.6E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME(101), A(101), E(101) / 'HXCDF_123789 ', 5.6E+01, 2.6E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME(102), A(102), E(102) / 'HPCDF_1234678 ', 2.8E+01, 1.6E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME(103), A(103), E(103) / 'HPCDF_1234789 ', 8.0E+01, 2.1E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME(104), A(104), E(104) / 'OTCDF ', 7.6E+01, 2.4E+03 / ! Paasivirta et al. (1999) + DATA SUBNAME(105), A(105), E(105) / 'NAPHTHOL ', 3.60E+03, 0.0E+00 / ! Eabraham et al. (1994) + DATA SUBNAME(106), A(106), E(106) / '1NITRONAPHTHALEN', 5.68E+02, 0.0E+00 / ! Altschuh et al. (1999) + DATA SUBNAME(107), A(107), E(107) / '2NITRONAPHTHALEN', 6.42E+02, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991) + DATA SUBNAME(108), A(108), E(108) / '14NAPHTHOQUINONE', 5.08E+05, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991) + DATA SUBNAME(109), A(109), E(109) / '24-TOLUENE_DIIS ', 7.25E+00, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991) + DATA SUBNAME(110), A(110), E(110) / 'HEXAMETHYLE_DIIS', 2.08E+01, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991) + DATA SUBNAME(111), A(111), E(111) / 'HYDRAZINE ', 1.14E+03, 0.0E+00 / ! Daubert and Danner (1989), and Amoore and Hautala (1983) + DATA SUBNAME(112), A(112), E(112) / 'MALEIC_ANHYDRIDE', 2.54E+02, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991) + DATA SUBNAME(113), A(113), E(113) / 'TRIETHYLAMINE ', 6.71E+00, 0.0E+00 / ! Yalkowsky and Dannenfelser (1992), and Riddick et al. (1986) + DATA SUBNAME(114), A(114), E(114) / 'P_DICHLOROBENZEN', 2.38E+00, 0.0E+00 / ! MacKay and Shiu (1981), measured + DATA SUBNAME(115), A(115), E(115) / 'M-XYLENE ', 1.43E-01, 3.9E+03 / ! Staudinger and Roberts (2001) + DATA SUBNAME(116), A(116), E(116) / 'P-XYLENE ', 1.35E-01, 3.7E+03 / ! Staudinger and Roberts (2001) + + DATA SUBNAME(117), A(117), E(117) / 'N-HEXANE ', 1.53E-02, 7.2E+03 / ! Staudinger and Roberts (2001) + DATA SUBNAME(118), A(118), E(118) / 'PROPANAL ', 1.64E+00, 5.4E+03 / ! Staudinger and Roberts (2001) + DATA SUBNAME(119), A(119), E(119) / 'STYRENE ', 3.82E-01, 4.4E+03 / ! Staudinger and Roberts (2001) + + DATA SUBNAME(120), A(120), E(120) / '124TRIMETH_BENZE', 1.50E-01, 4.3E+03 / ! Hanson et al. (1995) + DATA SUBNAME(121), A(121), E(121) / 'CHLOROACETALDEHY', 4.18E+01, 0.0E+00 / ! Bond Estimate by EPA SUITE PROGRAM (2007) + DATA SUBNAME(122), A(122), E(122) / 'CHLOROACETONE ', 3.82E-01, 0.0E+00 / ! Staudinger and Roberts (2001) + + DATA SUBNAME(123), A(123), E(123) / 'NITROSYL_CHLORID', 5.10E-01, 0.0E+00 / ! Bond Estimate by EPA SUITE PROGRAM (2007) + DATA SUBNAME(124), A(124), E(124) / 'NITRYL_CHLORIDE ', 2.43E-02, 0.0E+00 / ! Behnke et al. (1997), JGR, D102, 3795-3804 + DATA SUBNAME(125), A(125), E(125) / 'HEXYL_HYDROPEROX', 1.23E+01, 0.0E+00 / ! Bond Estimated by EPA SUITE PROGRAM (2007) + + DATA SUBNAME(126), A(126), E(126) / 'HYDROXY_NITRATES', 1.70E+04, 9.20E+03 / ! Shepson et al. (1996), Treves et al. (2000) + DATA SUBNAME(127), A(127), E(127) / 'HYDROXY_PEROXIDE', 8.30E+04, 7.40E+03 / ! using value for H2O2 + DATA SUBNAME(128), A(128), E(128) / 'PROPNN ', 1.00E+03, 0.00E+00 / ! Kames and Schurath (1992) + DATA SUBNAME(129), A(129), E(129) / 'HACET ', 2.93E+03, 0.00E+00 / ! Spaulding et al. (2002) + DATA SUBNAME(130), A(130), E(130) / 'PYRUVIC_ACID ', 3.00E+05, 5.20E+03 / ! Staudinger and Roberts (1996) + DATA SUBNAME(131), A(131), E(131) / 'XYLENOL ', 1.05E+03, 0.00E+03 / ! experimental value from EPA SUITE PROGRAM (2008) + DATA SUBNAME(132), A(132), E(132) / 'CATECHOL ', 3.16E+05, 0.00E+03 / ! experimental value from EPA SUITE PROGRAM (2008) + + DATA SUBNAME(133), A(133), E(133) / 'DIETHYLKETONE ', 2.00E+01, 9.2E+03 / ! ROLF SANDERS COMPILATION (1999)/JANINI AND QUADDORA (1986) + DATA SUBNAME(134), A(134), E(134) / 'N-PROPANOL ', 1.10E+02, 0.0E+00 / ! ROLF SANDERS COMPILATION (1999)/YAWS AND YANG (1992) + DATA SUBNAME(135), A(135), E(135) / 'ETHYLENEGLYCOL ', 4.00E+06, 0.0E+00 / ! ROLF SANDERS COMPILATION (1999)/BONE ET AL. (1983) + DATA SUBNAME(136), A(136), E(136) / 'HYDROXY-ACETONE ', 2.00E+04, 0.0E+00 / ! MATSUNAGA ET AL., 41, 790-796, AE, (2007) + DATA SUBNAME(137), A(137), E(137) / '2NITRO_1BUTNL ', 6.30E+03, 9.6E+03 / ! Shepson et al., 1992 + DATA SUBNAME(138), A(138), E(138) / 'PYROCATECHOL ', 4.60E+03, 0.0E+00 / ! Mackay et al., 1995 + + DATA B( LSO2 ), D( LSO2 ) / 1.30E-02, 1.96E+03 / ! SO2*H2O<=>HSO3+H : Smith and Martell (1976) + DATA B( LHSO3 ), D( LHSO3 ) / 6.60E-08, 1.50E+03 / ! HSO3<=>SO3+H : Smith and Martell (1976) + DATA B( LHNO2 ), D( LHNO2 ) / 5.10E-04, -1.26E+03 / ! HNO2(aq)<=>NO2+H : Schwartz and White (1981) + DATA B( LHNO3 ), D( LHNO3 ) / 1.54E+01, 8.70E+03 / ! HNO3(aq)<=>NO3+H : Schwartz (1984) + DATA B( LCO2 ), D( LCO2 ) / 4.30E-07, -1.00E+03 / ! CO2*H2O<=>HCO3+H : Smith and Martell (1976) + DATA B( LHCO3 ), D( LHCO3 ) / 4.68E-11, -1.76E+03 / ! HCO3<=>CO3+H : Smith and Martell (1976) + DATA B( LH2O2 ), D( LH2O2 ) / 2.20E-12, -3.73E+03 / ! H2O2(aq)<=>HO2+H : Smith and Martell (1976) + DATA B( LHCHO ), D( LHCHO ) / 2.53E+03, 4.02E+03 / ! HCHO(aq)<=>H2C(OH)2 : Le Hanaf (1968) + DATA B( LHCOOH ), D( LHCOOH ) / 1.80E-04, -2.00E+01 / ! HCOOH(aq)<=>HCOO+H : Martell and Smith (1977) + DATA B( LHO2 ), D( LHO2 ) / 3.50E-05, 0.00E+00 / ! HO2(aq)<=>H+O2 : Perrin (1982) + DATA B( LNH4OH ), D( LNH4OH ) / 1.70E-05, -4.50E+02 / ! NH4*OH<=>NH4+OH : Smith and Martell (1976) + DATA B( LH2O ), D( LH2O ) / 1.00E-14, -6.71E+03 / ! H2O<=>H+OH : Smith and Martell (1976) + DATA B( LATRA ), D( LATRA ) / 2.09E-02, 0.00E+00 / ! C8H14ClN5<=>C8H13ClN5+H : Weber (1970) + DATA B( LCL2 ), D( LCL2 ) / 5.01E-04, 0.00E+00 / ! CL2*H2O <=> HOCL + H + CL : LIN AND PEHKONEN, JGR, 103, D21, 28093-28102, NOVEMBER 20, 1998. ALSO SEE NOTE BELOW + DATA B( LHOCL ), D( LHOCL ) / 3.16E-08, 0.00E+00 / ! HOCL <=>H + OCL : LIN AND PEHKONEN, JGR, 103, D21, 28093-28102, NOVEMBER 20, 1998 + DATA B( LHCL ), D( LHCL ) / 1.74E+06, 6.90E+03 / ! HCL <=> H + CL : Marsh and McElroy (1985) + DATA B( LHYDRAZINE), D( LHYDRAZINE) / 1.11E-08, 0.00E+00 / ! HYDRAZINE <=> HYDRAZINE+ + OH- : Moliner and Street (1989) +!------------------------------------------------------------------------------- +! Note for dissociation constant for equation 14: CL2*H2O <=> HOCL + H + CL +! Need aqueous [CL-] concentration to calculate effective henry's law coefficient +! Used a value of 2.0 mM following Lin and Pehkonen, JGR, 103, D21, 28093-28102, November 20, 1998 +!------------------------------------------------------------------------------- + +C...........EXTERNAL FUNCTIONS and their descriptions: + + +C----------------------------------------------------------------------- +C begin body of subroutine HLCONST + + SPC = INDEX1( CNAME, MXSPCS, SUBNAME ) + +C...error if species not found in table + + IF ( SPC .LE. 0 ) THEN + XMSG = TRIM( CNAME ) // ' not found in Henry''s '// + & ' Law Constant table in routine HLCONST.' + CALL M3EXIT ( PNAME, 0, 0, XMSG, XSTAT2 ) + END IF + +C...compute the Henry's Law Constant + + TFAC = ( 298.0 - TEMP) / ( 298.0 * TEMP ) + KH = A( SPC ) * EXP( E( SPC ) * TFAC ) + HLCONST = KH + +C...compute the effective Henry's law constants + + IF ( EFFECTIVE ) THEN + + IF ( HPLUS .LE. 0.0 ) THEN + XMSG = 'Negative or Zero [H+] concentration specified ' // + & 'in HLCONST ' + CALL M3EXIT ( PNAME, 0, 0, XMSG, XSTAT2 ) + END IF + + HPLUSI = 1.0 / HPLUS + HPLUS2I = HPLUSI * HPLUSI + +C...assign a value for clminus. use 2.0 mM based on Lin and Pehkonene, 1998, JGR + + CLMINUS = 2.0E-03 ! chlorine ion conc [CL-] + CLMINUSI = 1.0 / CLMINUS ! 1 / CLMINUS + + CHECK_NAME: SELECT CASE ( TRIM( CNAME ) ) + + CASE ('SO2') ! SO2H2O <=> HSO3- + H+ + ! & HSO3- <=> SO3= + H+ + + AKEQ1 = B( LSO2 ) * EXP( D( LSO2 ) * TFAC ) + AKEQ2 = B( LHSO3 ) * EXP( D( LHSO3 ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI + AKEQ1 * AKEQ2 * HPLUS2I ) + + CASE ('HNO2') ! HNO2(aq) <=> NO2- + H+ + + AKEQ1 = B( LHNO2 ) * EXP( D( LHNO2 ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ('HNO3') ! HNO3(aq) <=> NO3- + H+ + + AKEQ1 = B( LHNO3 ) * EXP( D( LHNO3 ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ('CO2') ! CO2H2O <=> HCO3- + H+ + ! & HCO3- <=> CO3= + H+ + + AKEQ1 = B( LCO2 ) * EXP( D( LCO2 ) * TFAC ) + AKEQ2 = B( LHCO3 ) * EXP( D( LHCO3 ) * TFAC ) + HLCONST = KH + & * ( 1.0 + AKEQ1 * HPLUSI + AKEQ1 * AKEQ2 * HPLUS2I ) + + CASE ('H2O2') ! H2O2(aq) <=> HO2- + H+ + + AKEQ1 = B( LH2O2 ) * EXP( D( LH2O2 ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ('FORMALDEHYDE') ! HCHO(aq) <=> H2C(OH)2(aq) + + AKEQ1 = B( LHCHO ) * EXP( D( LHCHO ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 ) + + CASE ('FORMIC_ACID') ! HCOOH(aq) <=> HCOO- + H+ + + AKEQ1 = B( LHCOOH ) * EXP( D( LHCOOH ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ('HO2') ! HO2(aq) <=> H+ + O2- + + AKEQ1 = B( LHO2 ) * EXP( D( LHO2 ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ('NH3') ! NH4OH <=> NH4+ + OH- + + AKEQ1 = B( LNH4OH ) * EXP( D( LNH4OH ) * TFAC ) + AKEQ2 = B( LH2O ) * EXP( D( LH2O ) * TFAC ) + OHION = AKEQ2 * HPLUSI + HLCONST = KH * ( 1.0 + AKEQ1 / OHION ) + + CASE ('HYDRAZINE') ! HYDRAZINE <=> HYDRAZINE+ + OH- + + AKEQ1 = B( LHYDRAZINE ) * EXP( D( LHYDRAZINE ) * TFAC ) + AKEQ2 = B( LH2O ) * EXP( D( LH2O ) * TFAC ) + OHION = AKEQ2 * HPLUSI + HLCONST = KH * ( 1.0 + AKEQ1 / OHION ) + + CASE ('ATRA', 'DATRA') ! ATRA(aq) <=> ATRA- + H + ! or DATRA(aq) <=> DATRA- + H + + AKEQ1 = B( LATRA ) * EXP( D( LATRA ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ( 'CL2' ) ! CL2*H2O <=> HOCL + H + CL + ! HOCL <=>H + OCL + + AKEQ1 = B( LCL2 ) * EXP( D( LCL2 ) * TFAC ) + AKEQ2 = B( LHOCL ) * EXP( D( LHOCL ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI * CLMINUSI + & + AKEQ1 * AKEQ2 * HPLUS2I * CLMINUSI ) + + CASE ( 'HCL' ) ! HCL <=> H+ + CL- + + AKEQ1 = B( LHCL ) * EXP( D( LHCL ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + CASE ( 'HOCL' ) ! HOCL <=> H+ + OCL- + + AKEQ1 = B( LHOCL ) * EXP( D( LHOCL ) * TFAC ) + HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI ) + + END SELECT CHECK_NAME + + END IF + + RETURN + END diff --git a/models/CCTM/depv/blank/ABFLUX_MOD.F b/models/CCTM/depv/blank/ABFLUX_MOD.F new file mode 100755 index 0000000..0adb05a --- /dev/null +++ b/models/CCTM/depv/blank/ABFLUX_MOD.F @@ -0,0 +1,988 @@ + +!------------------------------------------------------------------------! +! 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/work/rep/arc/CCTM/src/depv/m3dry/ABFLUX_MOD.F,v 1.11 2012/04/19 17:03:23 yoj Exp $ + +!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module ABFlux_Mod + +! Contains the shared variables and subrountes needed for the bidirectional +! NH3 flux model in CMAQ +! +! INIT_ABFLUX - Intitializes the NH3 flux routines, allocates arrays, reads in +! intial soil NH3 & H concentrations, and fertilizer application +! amounts and timing for the model run +! +! Revision History: J. Bash Dec 08 10: Created +! J. Bash May 11 11: Updated for CMAQ 5.0 +! J.Young Oct 26 11: KIND=16->KIND=8 for Portland Group compiler (pgi) +! IsNaN function " " " " +! (This Module must be compiled w/ -Kieee if pgi) +! J. Bash Jan 31 12: New daily EPIC output now includes soil NH3 from +! mineralization of organic and no longer includes +! the monthly fertilizer totals. The initialization +! of soil NH3 was rewritten to reflect this. +! J. Bash Apr 19 12: Set bounds on the soil moisture from the met. model +! to be between saturation and residual soil moisture +! to avoid errors in the soil resistance from rounding +! errors. Corrected a units conversion error in the +! coupling of the soil NH4 to the atmospheric NH3. +! This will maintain a better mass balance and have +! a small impact on the model results ~ 1% of the +! ambient NH3 concentrations. +! J. Bash Apr 19 12: The apoplast compensation point for agricultural land use +! is now a function of the soil ammonium concentration +! following Massad et al. 2010 doi:10.5194/acp-10-10359-2010 +! J. Bash Aug 29 12: The subroutine was modified to utilize new EPIC output that +! estimates the ammonium content of fertilizer applied to the +! 1cm and 5cm soil layers. +! D. Schwede Sept 12 12: Added code for NLCD40 land use classification +! J. Bash Apr 4 13: Brought in new water, agriculture and snow land use +! classification in LSM_MOD to simplify the case structures +!--------------------------------------------------------------------------------------------- + + Implicit None +! shared variables + +! Private variables used in this module and subroutines + Real, Save, Allocatable, Private :: frac_ir( :,: ) ! irrigated fraction of ag + Real, Save, Allocatable, Private :: fagam1 ( :,: ) ! due to fertilizer app + Real, Save, Allocatable, Private :: fagam2 ( :,: ) ! due to fertilizer app + Real, Save, Allocatable, Private :: NH4ps1 ( :,:,: ) ! Initial Soil NH4 + Real, Save, Allocatable, Private :: NH4ps2 ( :,:,: ) ! Initial Soil NH4 + Real, Save, Allocatable, Private :: pHs1 ( :,:,: ) + Real, Save, Allocatable, Private :: pHs2 ( :,:,: ) + Real, Save, Private :: C_gam ! Canadian fertilizer facter + Real, Parameter, Private :: maxgam = 2.0e5 ! maximum soil gamm. It is assumed that any excess NH4 would from salts + Real, Parameter, Private :: natgam = 20.0 ! Background soil gamma + Integer, Save, Private :: logdev + + Contains + Subroutine Init_ABFlux( jdate, jtime) + + Use HGRD_DEFN ! horizontal grid specifications + Use UTILIO_DEFN + Use Bidi_Mod, Only: gamma1, gamma2, MHp1, MHp2 + + Implicit None +! Includes + Include SUBST_CONST ! constants + Include SUBST_FILES_ID ! file name parameters + +! Local Variables + + Integer, Intent( In ) :: jdate + Integer, Intent( In ) :: jtime + Integer :: c,r,l,k + Integer, Parameter :: e2c_cats = 42 ! number of crop catigories + Integer :: gxoff, gyoff ! global origin offset from file + integer, save :: strtcol, endcol, strtrow, endrow + + Real, Save, Allocatable :: F_rate1 ( :,:,: ) ! fertlizer application to layer 1 + Real, Save, Allocatable :: F_rate2 ( :,:,: ) ! fertlizer application to layer 2 + Real, Save, Allocatable :: Beld_ag ( :,:,: ) + Real :: Tot_Ag ! total ag in the grid cell + Real, Parameter :: convl1 = 7.142857e-04 ! ha/m**2 * mol/g N * 1/z_soil_l1 + Real, Parameter :: convl2 = 1.428571e-04 ! ha/m**2 * mol/g N * 1/z_soil_l2 + Real :: pHfac1 + Real :: pHfac2 + + Character( 16 ), Parameter :: pname = 'Init_ABFlux' + Character( 16 ) :: vname + Character( 96 ) :: xmsg = ' ' + Character( 20 ), Save :: Beld_Names( e2c_cats ) +C Some compilers do not pad with blank characters in data initialization +C '12345678901234567890' + Data Beld_Names / 'Hay ', ! 1 + & 'Hay_ir ', ! 2 + & 'Alfalfa ', ! 3 + & 'Alfalfa_ir ', ! 4 + & 'Other_Grass ', ! 5 + & 'Other_Grass_ir ', ! 6 + & 'Barley ', ! 7 + & 'Barley_ir ', ! 8 + & 'BeansEdible ', ! 9 + & 'BeansEdible_ir ', ! 10 + & 'CornGrain ', ! 11 + & 'CornGrain_ir ', ! 12 + & 'CornSilage ', ! 13 + & 'CornSilage_ir ', ! 14 + & 'Cotton ', ! 15 + & 'Cotton_ir ', ! 16 + & 'Oats ', ! 17 + & 'Oats_ir ', ! 18 + & 'Peanuts ', ! 19 + & 'Peanuts_ir ', ! 20 + & 'Potatoes ', ! 21 + & 'Potatoes_ir ', ! 22 + & 'Rice ', ! 23 + & 'Rice_ir ', ! 24 + & 'Rye ', ! 25 + & 'Rye_ir ', ! 26 + & 'SorghumGrain ', ! 27 + & 'SorghumGrain_ir ', ! 28 + & 'SorghumSilage ', ! 29 + & 'SorghumSilage_ir ', ! 30 + & 'Soybeans ', ! 31 + & 'Soybeans_ir ', ! 32 + & 'Wheat_Spring ', ! 33 + & 'Wheat_Spring_ir ', ! 34 + & 'Wheat_Winter ', ! 35 + & 'Wheat_Winter_ir ', ! 36 + & 'Other_Crop ', ! 37 + & 'Other_Crop_ir ', ! 38 + & 'Canola ', ! 39 + & 'Canola_ir ', ! 40 + & 'Beans ', ! 41 + & 'Beans_ir ' / ! 42 + + logdev = init3() + +! Find the Canadian fertilizer factor based off of Sheppard et al 2010 Canadian J. Soil Sci. & +! Zhang et al. 2010 JGR + Select Case( jdate ) + Case( 60:90 ) + C_gam = 811.5 + Case( 91:120 ) + C_gam = 3447.3 + Case( 121:151 ) + C_gam = 8702.8 + Case( 152:181 ) + C_gam = 1269.3 + Case( 182:212 ) + C_gam = 667.1 + Case( 213:243 ) + C_gam = 704.2 + Case( 244:273 ) + C_gam = 811.5 + Case( 274:304 ) + C_gam = 1376.7 + Case( 305:334 ) + C_gam = 1079.6 + Case Default + C_gam = 630.0 + End Select + +! get soil pH to estimate the emissions potential +! time in the files is not the same + If ( .Not. Open3( E2C_SOIL, fsread3, pname ) ) Then + xmsg = 'Could not open '// E2C_SOIL // ' file' + Call M3exit ( pname, jdate, jtime, xmsg, xstat1 ) + End If + + Call Subhfile ( E2C_SOIL, gxoff, gyoff, strtcol, endcol, strtrow, endrow ) + + If ( .Not. Allocated ( pHs1 ) ) Then + Allocate ( pHs1 ( my_ncols,my_nrows,e2c_cats ) ) + End If + + vname = 'L1_PH' + If ( .Not. Xtract3 ( E2C_SOIL, vname, 1, e2c_cats, strtrow, endrow, + & strtcol, endcol, jdate, 0, pHs1 ) ) Then + Write( xmsg,9001 ) vname, E2C_SOIL + Go To 1001 + End If + If ( .Not. Allocated ( pHs2 ) ) Then + Allocate ( pHs2 ( my_ncols,my_nrows,e2c_cats ) ) + End If + + vname = 'L2_PH' + If ( .Not. Xtract3 ( E2C_SOIL, vname, 1, e2c_cats, strtrow, endrow, + & strtcol, endcol, jdate, 0, pHs2 ) ) Then + Write( xmsg,9001 ) vname, E2C_SOIL + Go To 1001 + End If +! get soil fertilizer applicaiton rates and dates +! time in the files is not the same + If ( .Not. Open3( E2C_FERT, fsread3, pname ) ) Then + xmsg = 'Could not open '// E2C_FERT // ' file' + Call M3exit ( pname, 0, 0, xmsg, xstat1 ) + End If + If ( .Not. Allocated ( F_rate1 ) ) Then + Allocate ( F_rate1 ( my_ncols,my_nrows,e2c_cats ) ) + End If + If ( .Not. Allocated ( F_rate2 ) ) Then + Allocate ( F_rate2 ( my_ncols,my_nrows,e2c_cats ) ) + End If + + vname = 'L1_ANH3' + If ( .Not. Xtract3 (E2C_FERT, vname, 1, e2c_cats, strtrow, endrow, + & strtcol, endcol, jdate, 0, F_rate1 ) ) Then + Write( xmsg,9001 ) vname, E2C_FERT + Go To 1001 + End If + vname = 'L2_ANH3' + If ( .Not. Xtract3 (E2C_FERT, vname, 1, e2c_cats, strtrow, endrow, + & strtcol, endcol, jdate, 0, F_rate2 ) ) Then + Write( xmsg,9001 ) vname, E2C_FERT + Go To 1001 + End If +! get BELD4 land use types time independent files. + If ( .Not. Open3( BELD4_LU, fsread3, pname ) ) Then + xmsg = 'Could not open '// BELD4_LU // ' file' + Call M3exit ( pname, jdate, jtime, xmsg, xstat1 ) + End If + If ( .Not. Allocated ( Beld_ag ) ) Then + Allocate ( Beld_ag ( my_ncols,my_nrows,e2c_cats ) ) + End If + Do k = 1, e2c_cats + vname = BELD_Names(k) + If ( .Not. Interpx ( BELD4_LU, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, + & Beld_ag( :,:,k ) ) ) Then + Write( xmsg,9001 ) vname, BELD4_LU + Go To 1001 + End If + End Do + Beld_ag = 0.01 * Beld_ag ! convert to fraction + +! Allocate variable needed soil processes and fertilization + If ( .Not. Allocated ( gamma1 ) ) Then + Allocate ( gamma1 ( my_ncols,my_nrows ) ) + End If + gamma1 = 0.0 + If ( .Not. Allocated ( gamma2 ) ) Then + Allocate ( gamma2 ( my_ncols,my_nrows ) ) + End If + gamma2 = 0.0 + If ( .Not. Allocated ( fagam1 ) ) Then + Allocate ( fagam1 ( my_ncols,my_nrows ) ) + End If + fagam1 = 0.0 + If ( .Not. Allocated ( fagam2 ) ) Then + Allocate ( fagam2 ( my_ncols,my_nrows ) ) + End If + fagam2 = 0.0 + If ( .Not. Allocated ( MHp1 ) ) Then + Allocate ( MHp1 ( my_ncols,my_nrows ) ) + End If + MHp1 = 0.0 + If ( .Not. Allocated ( MHp2 ) ) Then + Allocate ( MHp2 ( my_ncols,my_nrows ) ) + End If + MHp2 = 0.0 + If ( .Not. Allocated ( frac_ir ) ) Then + Allocate ( frac_ir ( my_ncols,my_nrows ) ) + End If + frac_ir = 0.0 + +! get fertilizer from the previous month to estimate soil NH4+ +! time in the files is not the same + If ( .Not. Open3( INIT_MEDC_1, fsread3, pname ) ) Then + Write(Logdev,*) 'Estimating soil NHx from EPIC output' + If ( .Not. Open3( E2C_FERT, fsread3, pname ) ) Then + xmsg = 'Could not open '// E2C_FERT // ' file' + Call M3exit ( pname, jdate, jtime, xmsg, xstat1 ) + End If + If ( .Not. Allocated ( NH4ps1 ) ) Then + Allocate ( NH4ps1 ( my_ncols,my_nrows,e2c_cats ) ) + End If + NH4ps1 = 0.0 + If ( .Not. Allocated ( NH4ps2 ) ) Then + Allocate ( NH4ps2 ( my_ncols,my_nrows,e2c_cats ) ) + End If + NH4ps2 = 0.0 + vname = 'L1_NH3' + If ( .Not. Xtract3 (E2C_FERT, vname, 1, e2c_cats, strtrow, endrow, + & strtcol, endcol, jdate, 0, NH4ps1) ) Then + Write( xmsg,9001 ) vname, E2C_FERT + Go To 1001 + End If + vname = 'L2_NH3' + If ( .Not. Xtract3 (E2C_FERT, vname, 1, e2c_cats, strtrow, endrow, + & strtcol, endcol, jdate, 0, NH4ps2) ) Then + Write( xmsg,9001 ) vname, E2C_FERT + Go To 1001 + End If + + ! parameters + Do r = 1, my_nrows + Do c = 1, my_ncols + Tot_Ag = 0.0 + Do l = 1, e2c_cats + pHfac1 = 10.0 ** (-pHs1( c,r,l ) ) + pHfac2 = 10.0 ** (-pHs2( c,r,l ) ) +! convert units from kg/ha N to mol/l + If ( pHs1( c,r,l ) .Gt. 4.0 .And. + & pHs2( c,r,l ) .Gt. 4.0 .And. + & pHs1( c,r,l ) .Lt. 9.0 .And. + & pHs2( c,r,l ) .Lt. 9.0 .And. + & NH4ps1( c,r,l ) .Gt. 0.0 .And. + & NH4ps2( c,r,l ) .Gt. 0.0 .And. + & .Not. IsNaN( pHs1( c,r,l ) ) .And. + & .Not. IsNaN( pHs2( c,r,l ) ) .And. + & .Not. IsNaN( NH4ps1( c,r,l ) ) .And. + & .Not. IsNaN( NH4ps2( c,r,l ) ) .And. + & Beld_ag( c,r,l ) .Gt. 0.0 ) Then + If ( Index( Beld_Names( l ), '_ir' ) .Gt. 0 ) Then + frac_ir( c,r ) = frac_ir( c,r ) + Beld_ag( c,r,l ) + End If + Tot_Ag = Tot_Ag + Beld_ag( c,r,l ) + gamma1( c,r ) = gamma1( c,r ) + convl1 * NH4ps1( c,r,l ) + & / pHfac1 * Beld_ag( c,r,l ) + MHp1( c,r ) = MHp1( c,r ) + Beld_ag( c,r,l ) * pHfac1 + gamma2( c,r ) = gamma2( c,r ) + convl2 * NH4ps2( c,r,l ) + & / pHfac2 * Beld_ag( c,r,l ) + MHp2( c,r ) = MHp2( c,r ) + Beld_ag( c,r,l ) * pHfac2 + If ( .Not. IsNaN( F_rate1( c,r,l ) ) .And. + & F_rate1( c,r,l ) .Gt. 0.0 ) Then +! Surface applied fertlizer + fagam1( c,r ) = fagam1( c,r ) + F_rate1( c,r,l ) * Beld_ag( c,r,l ) + & * convl1 / pHfac1 + End If + If ( .Not. IsNaN( F_rate2( c,r,l ) ) .And. + & F_rate2( c,r,l ) .Gt. 0.0 ) Then +! Injected fertilizer + fagam2( c,r ) = fagam2( c,r ) + F_rate2( c,r,l ) * Beld_ag( c,r,l ) + & * convl2 / pHfac2 + End If + If ( IsNaN( fagam1( c,r ) ) .Or. IsNaN( fagam2( c,r ) ) ) Then + xmsg = 'NaN in fagam Calculation' + Call M3exit( pname, jdate, jtime, xmsg, xstat1 ) + End If + End If + End Do ! e2c_cats + If ( Tot_Ag .ge. 1.0e-6 .And. ! ~ 1.5 ha per grid cell + & MHp1( c,r ) / Tot_Ag .Gt. 1.0e-9 .And. + & MHp1( c,r ) / Tot_Ag .Lt. 1.0e-4 .And. + & MHp2( c,r ) / Tot_Ag .Gt. 1.0e-9 .And. + & MHp2( c,r ) / Tot_Ag .Lt. 1.0e-4 ) Then +! get the agricultrual only relevant number + MHp1( c,r ) = MHp1( c,r ) / Tot_Ag + MHp2( c,r ) = MHp2( c,r ) / Tot_Ag + gamma1( c,r ) = ( gamma1( c,r ) + fagam1( c,r ) ) / Tot_Ag + gamma2( c,r ) = ( gamma2( c,r ) + fagam2( c,r ) ) / Tot_Ag +! Set a minimum Gamma for Ag based off of Zhang et al. 2010 + gamma1( c,r ) = max( gamma1( c,r ), 630.0 ) + gamma2( c,r ) = max( gamma2( c,r ), 630.0 ) + If ( IsNaN( gamma1( c,r ) ) .Or. IsNaN( gamma2( c,r ) ) .Or. + & IsNaN( MHp2( c,r ) ) .Or. IsNaN( MHp2( c,r ) ) ) Then + xmsg = 'NaN in grid cell Gamma Calculation' + Call M3exit( pname, jdate, jtime, xmsg, xstat1 ) + End If + Else + MHp1( c,r ) = 0.0 + MHp2( c,r ) = 0.0 + gamma1( c,r ) = 0.0 + gamma2( c,r ) = 0.0 + End If + End Do ! c + End Do ! r +! xmsg = 'NaN in fagam Calculation' ! JOB debugging +! Call M3exit( pname, jdate, jtime, xmsg, xstat1) ! JOB debuggin + + Else ! read +! for whatever reason the jdate and jtime get messed up by the e2c files + Write( Logdev,* ) 'Reading soil NHx from Previous CMAQ run' + + vname = 'Gamma1' + If ( .Not. Xtract3 ( INIT_MEDC_1, vname, 1, 1, strtrow, endrow, + & strtcol, endcol, jdate, 000000, gamma1 ) ) Then + Write( xmsg,9001 ) vname, INIT_MEDC_1 + Go To 1001 + End If + vname = 'Gamma2' + If ( .Not. Xtract3 ( INIT_MEDC_1, vname, 1, 1, strtrow, endrow, + & strtcol, endcol, jdate, 000000, gamma2 ) ) Then + Write( xmsg,9001 ) vname, INIT_MEDC_1 + Go To 1001 + End If + vname = 'MHpsl1' + If ( .Not. Xtract3 ( INIT_MEDC_1, vname, 1, 1, strtrow, endrow, + & strtcol, endcol, jdate, 000000, MHp1 ) ) Then + Write( xmsg,9001 ) vname, INIT_MEDC_1 + Go To 1001 + End If + vname = 'MHpsl2' + If ( .Not. Xtract3 ( INIT_MEDC_1, vname, 1, 1, strtrow, endrow, + & strtcol, endcol, jdate, 000000, MHp2 ) ) Then + Write( xmsg,9001 ) vname, INIT_MEDC_1 + Go To 1001 + End If + + do r = 1, my_nrows + Do c = 1, my_ncols + Tot_Ag = 0.0 + Do l = 1, e2c_cats + pHfac1 = 10.0 ** (-pHs1( c,r,l ) ) + pHfac2 = 10.0 ** (-pHs2( c,r,l ) ) +! convert units from kg/ha N to mol/l + If ( Index( Beld_Names( l ), '_ir' ) .Gt. 0 ) Then + frac_ir( c,r ) = frac_ir( c,r ) + Beld_ag( c,r,l ) + End If + Tot_Ag = Tot_Ag + Beld_ag( c,r,l ) + If ( .Not. IsNaN( F_rate1( c,r,l ) ) .And. + & F_rate1( c,r,l ) .Gt. 0.0 .And. + & .Not. IsNaN( pHs1( c,r,l ) ) .And. + & pHs1( c,r,l ) .Gt. 4.0 .And. + & pHs1( c,r,l ) .Lt. 9.0 ) Then +! surface applied fertilizer + fagam1( c,r ) = fagam1( c,r ) + F_rate1( c,r,l ) * Beld_ag( c,r,l ) + & * convl1 / pHfac1 + End If + If ( .Not. IsNaN( F_rate2( c,r,l ) ) .And. + & F_rate2( c,r,l ) .Gt. 0.0 .And. + & .Not. IsNaN( pHs2( c,r,l ) ) .And. + & pHs2( c,r,l ) .Gt. 4.0 .And. + & pHs2( c,r,l ) .Lt. 9.0 ) Then +! Injected fertilizer + fagam2( c,r ) = fagam2( c,r ) + F_rate2( c,r,l ) * Beld_ag( c,r,l ) + & * convl2 / pHfac2 + End If + If ( IsNaN( fagam1( c,r ) ) .Or. IsNaN( fagam2( c,r ) ) ) Then + xmsg = 'NaN in fagam Calculation' + Call M3exit( pname, jdate, jtime, xmsg, xstat1) + End If + End Do ! e2c_cats +! Agricultural only numbers were written to file + If ( Tot_Ag .Gt. 1.0e-6 .And. + & MHp1( c,r ) .Gt. 1.0e-9 .And. + & MHp1( c,r ) .Lt. 1.0e-5 .And. + & MHp2( c,r ) .Gt. 1.0e-9 .And. + & MHp2( c,r ) .Lt. 1.0e-5 ) Then +! get the agricultrual only relevant number + gamma1( c,r ) = gamma1( c,r ) + fagam1( c,r ) / Tot_Ag + gamma2( c,r ) = gamma2( c,r ) + fagam2( c,r ) / Tot_Ag + If ( IsNaN( gamma1( c,r ) ) .Or. IsNaN( gamma2( c,r ) ) .Or. + & IsNaN( MHp2( c,r ) ) .Or. IsNaN( MHp2( c,r ) )) Then + xmsg = 'NaN in grid cell Gamma Calculation' + Call M3exit( pname, jdate, jtime, xmsg, xstat1 ) + End If + End If + End Do ! c + End Do ! r + End If ! INIT_MEDC_1 + + Return +!------------------------------------------------------------------------------ +! Error handling section +!------------------------------------------------------------------------------ +1001 Continue + Call M3exit( pname, jdate, jtime, xmsg, xstat1 ) + +C------------------------------------------------------------------------------- +C Format statements. +C------------------------------------------------------------------------------- + +9001 Format( 'Failure reading ', a, 1x, 'from ', a ) + + Return + + End Subroutine Init_ABFlux + +!------------------------------------------------------------------------------ +! Subroutine to get the soil and canopy compensation point +!------------------------------------------------------------------------------ + Subroutine Get_Flux( tempg, rh_air, cNH3, rwetsfc, rgw, wg, w2, Sltype, dif, + & row, col, sp, pvd, lnh3, f_stom, f_cut, f_soil, f_emis, + & f_dep, f_ag, f_nag, f_wat, dt, jtime ) + + Use UTILIO_DEFN + Use Bidi_Mod, Only: gamma1, gamma2, MHp1, MHp2, lufrac + Use Mosaic_Mod + Use LSM_MOD + + Implicit None + + Include SUBST_CONST ! constants + Include SUBST_FILES_ID ! file name parameters + + Real, Intent( IN ) :: tempg + Real, Intent( IN ) :: rh_air + Real, Intent( IN ) :: cNH3 + Real, Intent( IN ) :: rwetsfc + Real, Intent( IN ) :: rgw + Real, Intent( IN ) :: wg + Real, Intent( IN ) :: w2 + Real, Intent( IN ) :: Sltype + Real, Intent( IN ) :: dif + + Integer, Intent( IN ) :: row + Integer, Intent( IN ) :: col + Integer, Intent( IN ) :: sp ! species index + + Real, Intent( OUT ) :: pvd + Real, Intent( OUT ) :: lnh3 + Real, Intent( OUT ) :: f_stom + Real, Intent( OUT ) :: f_cut + Real, Intent( OUT ) :: f_soil + Real, Intent( OUT ) :: f_emis + Real, Intent( OUT ) :: f_dep + Real, Intent( OUT ) :: f_ag + Real, Intent( OUT ) :: f_nag + Real, Intent( OUT ) :: f_wat + + Integer, Intent( IN ) :: dt + Integer, Intent( IN ) :: jtime + + Real, Parameter :: kvis = 0.132 ! [cm**2/s] at 273.15K + Real( 8 ) :: aq ! Quadradic equation variable + Real( 8 ) :: bq ! Quadradic equation variable + Real :: cnh3c ! In canopy NH3 concentration [ppm] + Real :: cnh3g1, cnh3g2 ! NH3 compensation concentration for ground [ppm] + Real :: cnh3s ! NH3 compensation concentration for stomatal [ppm] + Real( 8 ) :: cq ! Quadradic equation variable + Real :: del0 ! for Rbg + Real( 8 ) :: ga ! Ga = 1/Ra [m/s] + Real :: gammas ! [NH4+]/[H+] + Real( 8 ) :: gcw + Real( 8 ) :: gg1( n_lufrac ) ! Gg = 1/(Rgnd(nh3)+Rinc) [m/s] + Real( 8 ) :: gg2( n_lufrac ) ! Gg = 1/(Rgnd(nh3)+Rinc) [m/s] + Real( 8 ) :: gsb ! Gsb = 1/(Rstom(nh3)+Rb(nh3)) [m/s] + Real( 8 ) :: gt + Real, Parameter :: karman = 0.4 ! von Karman constant + Real( 8 ) :: qq ! intermediate variable + Real :: rbgj( n_lufrac ) +! Real, Parameter :: rwm = 35.0 ! Minimum NH3 cuticle resistance [s/m] + Real, Parameter :: rwm = 20.0 ! Minimum NH3 cuticle resistance [s/m] + Real :: rwmb ! Rwmb = Rwm + Rb + Real :: rwx ! Rw = Rwm + Rwx * CNH3C [s/m] + Real :: scn ! for Rbg + Real :: ustg ! for Rbg + Real :: vdg ! Vd(nh3) to non-veg part [m/s] + Real :: wg_ir ! 1 cm soil moisture + Real :: w5cm ! soil moisture in top 5 cm (vol frc) + Real, Parameter :: d1 = 0.01 ! Top soil layer depth (1 cm) + Real, Parameter :: d2 = 0.05 ! Bottom soil layer mid depth (5 cm) + Real, Parameter :: twothree = 2.0/3.0 + Real, Parameter :: onethree = 1.0/3.0 + Real, Parameter :: MolN = 14.007 ! g/mol N + Real, Parameter :: MolNH3 = 17.01 ! g/mol NH3 + Real( 8 ) :: ldry + Real( 8 ) :: dp + Real( 8 ) :: rsoil1 + Real( 8 ) :: rsoil2 + Real( 8 ) :: a1 + Real( 8 ) :: agfrac + Real( 8 ) :: sqrr + Real( 8 ) :: ddd + Real( 8 ) :: watfrac ! water fraction + Real :: xxx ! lumped variable + Real, Parameter :: f_emis_lim = -1.0e-07 ! limit to report to log: if below, probably due to numerical precision error + Integer :: k,j + Integer :: ist + + logdev = init3() +!> Compute quasi-laminar boundary layer resistance at the soil surface + + scn = kvis / dif + Do j = 1, n_lufrac + ustg = max( ustarj( j,col,row ) * EXP( -laij( j,col,row ) ), 0.001 ) + del0 = 1.0E-4 * kvis / ( karman * ustg ) + rbgj( j ) = ( scn - LOG( 10.0 * del0 ) ) / ( karman * ustg ) + End Do + +!> Compute soil resistance + + ist = nint( Sltype ) + + If ( ist .lt. 1 .or. ist .gt. 11 ) Then + ist = 4 + End If + + If ( frac_ir( col,row ) .Gt. 0.0 .And. wg .LT. 0.75 * wfc( ist ) ) Then + wg_ir = ( 1.0 - frac_ir( col,row ) ) * wg + frac_ir( col,row ) * 0.75 * wfc( ist ) + Else + wg_ir = wg + End If + + wg_ir = Min( wg_ir,wsat( ist ) ) + wg_ir = Max( wg_ir,wres( ist ) ) + + ldry= d1 * ( Exp( ( 1.0 - wg_ir / wsat( ist ) ) ** 5 ) - 1.0 ) / 1.718 + + dp = dif * 1.0E-4 * wsat( ist ) * wsat( ist ) + & * ( 1.0 - wres( ist ) / wsat( ist ) ) ** ( 2.0 + 3.0 / bslp( ist ) ) + + rsoil1=ldry/dp + + w5cm = 0.2 * wg_ir + 0.8 * w2 + w5cm = Min( w5cm, wsat( ist ) ) + w5cm = Max( w5cm, wres( ist ) ) + + If ( frac_ir( col,row ) .Gt. 0.0 .And. w5cm .LT. 0.75 * wfc( ist ) ) Then + w5cm = ( 1.0 - frac_ir( col,row ) ) * w5cm + frac_ir( col,row ) * 0.75 * wfc( ist ) + End If + + ldry = d2 * ( Exp( ( 1.0 - w5cm / wsat( ist ) ) ** 5 ) - 1.0 ) / 1.718 + rsoil2 = ldry / dp + + If ( Land_Scheme .Eq. 'USGS24' ) Then + agfrac = lufrac( 2,col,row ) + lufrac( 3,col,row ) + & + lufrac( 4,col,row ) + + & twothree * lufrac( 5,col,row ) + twothree * lufrac( 6,col,row ) + watfrac = lufrac( 16,col,row ) + End If + + If ( Land_Scheme .Eq. 'NLCD50' ) Then + agfrac = lufrac( 19,col,row ) + lufrac( 20,col,row ) + & + lufrac( 43,col,row ) + twothree * lufrac( 45,col,row ) + watfrac = lufrac( 1,col,row ) + lufrac( 31,col,row ) + & + lufrac( 48,col,row ) + End If + + If ( Land_Scheme .Eq. 'NLCD40' ) Then + agfrac = lufrac( 12,col,row ) + lufrac( 37,col,row ) + & + lufrac( 38,col,row ) + twothree * lufrac( 14,col,row ) + watfrac = lufrac( 17,col,row ) + lufrac( 21,col,row ) + End If + + If ( Land_Scheme .Eq. 'MODIS' ) Then + agfrac = lufrac( 12,col,row ) + twothree * lufrac( 14,col,row ) + watfrac = lufrac( 17,col,row ) + End If + + pvd = 0.0 + lnh3 = 0.0 + f_emis = 0.0 + f_dep = 0.0 + f_stom = 0.0 + f_cut = 0.0 + f_soil = 0.0 + f_ag = 0.0 + f_nag = 0.0 + f_wat = 0.0 + + Do j = 1, n_lufrac + If ( lufrac( j,col,row ) .Gt. 0.0 ) Then + +!> If the soil is frozen assume not evasive flux and skip calculation of comp. points + If ( Tempg .Le. 273.15 ) Then + cnh3s = 0.0 + cnh3g1 = 0.0 + cnh3g2 = 0.0 + Go To 101 + End If + +!> Compute compensation point. gamma is specified according to the amount of +!> cultivated vegetation + gammas = luf_fac_p( j ) + a1 = 161512.0d0 / real( tempg, 8 ) + & * 10.0d0 ** ( -4507.11d0 / real( tempg, 8 ) ) + a1 = a1 * 24.5d0 * 1.0d6 ! ppm + cnh3s = a1 * gammas + +!> Set a maximum [NH4]/[H+] ratio at 200,000 based on output from the AIM aerosol +!> model any [NH4] in excess of this ratio is assumed to partition into the solid +!> phase. Canada soil gamma taken from Zhang et al 2010 JGR Table 5 + Select Case( cat_lu( j ) ) + + Case( 'WATER','SNOWICE' ) ! water, ice or snow + + cnh3g1 = 0.0 + + cnh3g2 = 0.0 + + Case( 'AG' ) ! Ag + + cnh3g1 = Min( Max( gamma1( col,row ) / wg_ir, C_gam / wg_ir ), + & maxgam) + + cnh3g2 = Min( Max( gamma2( col,row ) / w5cm, C_gam / w5cm), + & maxgam ) + + cnh3s = Max( cnh3s, a1 *( Max(gamma2(col,row),C_gam) * 1.0e-7 + & * w5cm * MolN * d2 * 1.0e4 * 12.3 + 20.3 ) ) + + Case( 'AGMOS' ) ! Ag mosaic 67% ag 33% mosaic + + cnh3g1 = Min( Max( gamma1( col,row ) / wg_ir, C_gam / wg_ir) + & * twothree + onethree * natgam / wg_ir, maxgam ) + + cnh3g2 = Min( Max( gamma2( col,row ) / w5cm, C_gam / w5cm ) + & * twothree + onethree * natgam / w5cm, maxgam ) + + cnh3s = Max( cnh3s, a1 * ( Max(gamma2(col,row),C_gam) * 1.0e-7 + & * w5cm * MolN * d2 *1.0e4 * 12.3 + 20.3 ) ) + & * twothree + onethree * cnh3s + + Case Default ! not ag + + cnh3g1 = Min( natgam / wg_ir, maxgam ) + + cnh3g2 = Min( natgam / w5cm, maxgam ) + + End Select + + cnh3g1 = a1 * Max( cnh3g1, 0.01 ) + cnh3g2 = a1 * Max( cnh3g2, 0.01 ) + +101 Continue + +!> Cuticle resistance : rw = rwx * cnh3c + rwm + If ( laij( j,col,row ) .Gt. 0.0 ) Then + + rwx = rwetsfc * MolNH3 * 1000.0 / 24.5 ! in ppb/ cso2c + rwmb = rwm * Max( 1.0, 0.5 * ( 100.0-rh_air ) ) + rbcj( j ) + ga = 1.0 / ( raj( j,col,row ) + 0.5 * rincj( j,col,row ) ) + gsb = 1.0 / ( rstomj( j,sp,col,row ) + rbcj( j ) ) + gg1( j )= 1.0 / ( rbgj( j ) + 0.5 * rincj( j,col,row ) + rsoil1 ) + gg2( j )= 1.0 / ( rbgj( j ) + 0.5 * rincj( j,col,row ) + rsoil2 ) + gcw = laij( j,col,row ) / ( rbcj( j ) + rwetsfc ) + gt = gsb + gg1( j ) + gg2( j ) + ga + deltaj( j,col,row ) * gcw + qq = ga * cnh3 + gsb * cnh3s + gg1( j ) * cnh3g1 + gg2( j ) * cnh3g2 + aq = rwx * gt + bq = rwmb * gt + laij( j,col,row ) * ( 1.0 - deltaj( j,col,row ) ) - rwx * qq + cq = -rwmb * qq + sqrr = -0.5d0 * ( bq + sign( 1.0d0,bq ) * sqrt( bq * bq - 4.0d0 * aq * cq ) ) +!> find the positive root + If ( sqrr .Ge. 0.0 ) Then + cnh3c = sqrr / aq + Else ! because cq is always negative + cnh3c = cq / sqrr + End If +! if the compensation point less than zero reset it to zero + cnh3c = max( cnh3c, 0.0 ) + + ddd = ( 1.0 - deltaj( j,col,row ) ) / rgndcj( j,col,row ) + & + deltaj( j,col,row ) / rgw + + vdg = 1.0 / ( raj( j,col,row ) + rbcj( j ) + 1.0 / ddd ) + End If ! laij > 0.0 + +!> Integrate over the land uses + Select Case( cat_lu( j ) ) + Case( 'WATER','SNOWICE' ) ! no vegetation + lnh3 = lnh3 + lufrac( j,col,row ) / ( rsurfj( j,sp,col,row ) + & + raj( j,col,row ) ) + Case Default ! vegetation + pvd = pvd + lufrac( j,col,row ) * cnh3c * ga * vegj( j,col,row ) + lnh3 = lnh3 + lufrac( j,col,row ) * ( ( 1.0 - vegj( j,col,row ) ) + & * vdg + vegj( j,col,row ) * ga ) + End Select + +!> -------Compute Fluxes and integrate over LU for output JOB ------------------- + Select Case( cat_lu( j ) ) + Case( 'WATER' ) ! water + f_dep = f_dep + lufrac( j,col,row ) / ( rsurfj( j,sp,col,row )+raj( j,col,row ) ) * cnh3 + f_wat = f_wat + lufrac( j,col,row ) / ( rsurfj( j,sp,col,row )+raj( j,col,row ) ) * cnh3 + & / watfrac + Case( 'SNOWICE' ) ! no veg +!> Zero out the compensation points for deposition + xxx = rwx * ga * cnh3 - rwmb * gt - laij( j,col,row ) * ( 1.0 - deltaj( j,col,row ) ) + f_dep = f_dep + lufrac( j,col,row ) * ( vegj( j,col,row ) * ga + & * ( cnh3 - ( xxx + Sqrt( xxx**2 + 4.0 * aq * rwmb * ga * cnh3 ) ) + & / ( 2.0 * aq ) ) + ( 1.0 - vegj( j,col,row ) ) * vdg * cnh3 ) + Case( 'AG','AGMOS' ) ! agriculture +!> Zero out the atmospheric NH3 concentration for emissions + xxx = rwx * ( qq - ga*cnh3 ) - rwmb * gt - laij( j,col,row ) * ( 1.0 - deltaj( j,col,row ) ) + f_emis = f_emis + lufrac( j,col,row ) * vegj( j,col,row ) * ga * ( xxx + & + Sqrt( xxx**2 + 4.0 * aq * rwmb * ( qq - ga * cnh3 ) ) ) / ( 2.0 * aq ) +!> Zero out the compensation points for deposition + xxx = rwx * ga * cnh3 - rwmb * gt - laij( j,col,row ) * ( 1.0 - deltaj( j,col,row ) ) + f_dep = f_dep + lufrac( j,col,row ) * ( vegj( j,col,row ) * ga + & * ( cnh3 - ( xxx + Sqrt( xxx**2 + 4.0 * aq * rwmb * ga * cnh3 ) ) + & / ( 2.0 * aq ) ) + ( 1.0 - vegj( j,col,row ) ) * vdg * cnh3 ) +!> Components of the flux for stomatal, cuticular and soil surfaces + f_stom = f_stom + lufrac( j,col,row ) * vegj( j,col,row ) * ( cnh3s - cnh3c ) * gsb ! component 1 stomatal + f_cut = f_cut + lufrac( j,col,row ) * ( - cnh3c * vegj( j,col,row ) * laij( j,col,row ) + & * ( deltaj( j,col,row ) / ( rbcj( j ) + rwetsfc ) ! wet cuticle + & + ( 1.0 - deltaj( j,col,row ) ) / ( rwmb + rwx*cnh3c ) ) ) ! dry cuticle + f_soil = f_soil + lufrac( j,col,row ) * ( vegj( j,col,row ) * ( (cnh3g1 - cnh3c) * gg1( j ) ! soil layer 1 + & + ( cnh3g2 - cnh3c ) * gg2( j ) ) ) ! soil layer 2 + f_ag = f_ag + lufrac( j,col,row ) * ( vegj( j,col,row ) * ga * ( cnh3c - cnh3 ) + & -( 1.0 - vegj( j,col,row ) ) * vdg * cnh3 ) / agfrac + If ( f_emis .lt. f_emis_lim ) Then + Write(logdev,*) 'ag f_emis: ', f_emis + Write(logdev,*) 'ag f_ag : ', f_ag + Write(logdev,*) 'ag f_dep : ', f_dep + Write(logdev,*) 'ag f_stom: ', f_stom + Write(logdev,*) 'ag f_cut : ', f_cut + Write(logdev,*) 'ag f_soil: ', f_soil + Write(logdev,*) 'ag lufrac: ', lufrac( j,col,row ) + Write(logdev,*) 'ag vegj : ', vegj( j,col,row ) + Write(logdev,*) 'ag ga : ', ga + Write(logdev,*) 'ag vdg : ', vdg + Write(logdev,*) 'ag agfrac: ', agfrac + End If + Case Default ! natural +!> Zero out the atmospheric NH3 concentration for emissions + xxx = rwx * ( qq - ga * cnh3 ) - rwmb * gt - laij( j,col,row ) * ( 1.0 - deltaj( j,col,row ) ) + f_emis = f_emis + lufrac( j,col,row ) * vegj( j,col,row ) * ga * ( xxx + & + Sqrt( xxx**2 + 4.0 * aq * rwmb * ( qq - ga * cnh3 ) ) ) / ( 2.0 * aq ) +!> Zero out the compensation points for deposition + xxx = rwx * ga * cnh3 - rwmb * gt - laij( j,col,row ) * ( 1.0 - deltaj( j,col,row ) ) + f_dep = f_dep + lufrac( j,col,row ) * ( vegj( j,col,row ) * ga + & * ( cnh3 - ( xxx + Sqrt( xxx**2 + 4.0 * aq * rwmb * ga * cnh3 ) ) + & / ( 2.0 * aq ) ) + ( 1.0 - vegj( j,col,row ) ) * vdg * cnh3 ) +!> Components of the flux for stomatal, cuticular and soil surfaces + f_stom = f_stom + lufrac( j,col,row ) * vegj( j,col,row ) * ( cnh3s - cnh3c ) * gsb ! component 1 stomatal + f_cut = f_cut + lufrac( j,col,row ) * ( - cnh3c * vegj( j,col,row ) * laij( j,col,row ) + & * ( deltaj( j,col,row ) / ( rbcj( j ) + rwetsfc ) ! wet cuticle + & + ( 1.0 - deltaj( j,col,row ) ) / ( rwmb + rwx * cnh3c ) ) ) ! dry cuticle + f_soil = f_soil + lufrac( j,col,row ) * ( vegj( j,col,row ) * ( ( cnh3g1 - cnh3c ) * gg1( j ) + ! soil layer 1 + & ( cnh3g2 - cnh3c ) * gg2( j )) ) ! soil layer 2 + f_nag = f_nag + lufrac( j,col,row ) * ( vegj( j,col,row ) * ga * ( cnh3c- cnh3 ) + & - ( 1.0 - vegj( j,col,row ) ) * vdg * cnh3 ) / ( 1.0 - agfrac - watfrac ) + If ( f_emis .lt. f_emis_lim ) Then + Write(logdev,*) 'f_emis: ', f_emis + Write(logdev,*) 'f_nag : ', f_nag + Write(logdev,*) 'f_dep : ', f_dep + Write(logdev,*) 'f_stom: ', f_stom + Write(logdev,*) 'f_cut : ', f_cut + Write(logdev,*) 'f_soil: ', f_soil + Write(logdev,*) 'lufrac: ', lufrac( j,col,row ) + Write(logdev,*) 'vegj : ', vegj( j,col,row ) + Write(logdev,*) 'ga : ', ga + Write(logdev,*) 'vdg : ', vdg + Write(logdev,*) 'agfrac: ', agfrac + End If + End Select + End If ! Lufrac > 0.0 + End Do ! n_lufrac + +!> -----Compute nitrification rates for agricultural areas only where there is NHx and H+ + If ( gamma1( col,row ) .Gt. 0.0 .And. MHp1( col,row ) .Gt. 1.0e-9 .And. + & MHp1( col,row ) .Lt. 1.0e-5 ) Then + Call Calc_Nitrif ( Tempg, wg_ir, Cnh3c, gg1, gamma1( col,row ), ist, dt, + & MHp1( col,row ), col, row, d1 ) + End If + If ( gamma2( col,row ) .Gt. 0.0 .And. MHp2( col,row ) .Gt. 1.0e-9 .And. + & MHp2( col,row ) .Lt. 1.0e-5 ) Then + Call Calc_Nitrif ( Tempg, w5cm, Cnh3c, gg2, gamma2( col,row ), ist, dt, + & MHp2( col,row ), col, row, d2 ) + End If + + Return + End Subroutine Get_Flux +!------------------------------------------------------------------------------ +! Subroutine to update the soil ammonia and pH due to evasion, deposition, +! nitrification, leaching, and run off +! Soil ammonium, pH, leaching, and run off are defined in the module +!------------------------------------------------------------------------------ + Subroutine Calc_Nitrif ( Tempg, wg, CNH3c, gg, gam, ist, dt, MHp, C, R, ds ) + + Use UTILIO_DEFN + Use Bidi_Mod, Only: lufrac + Use LSM_MOD + + Implicit None + + Real, Intent( IN ) :: Tempg ! Soil Temperature + Real, Intent( IN ) :: wg ! Soil Moisture + Real, Intent( IN ) :: CNH3c ! Canopy compensation point + Real, Intent( IN ) :: MHp ! molar H concentration + Real( 8 ), Intent( IN ) :: gg(n_lufrac) ! soil-air conductance + Real, Intent( IN ) :: ds ! soil depth in m + Real, Intent( INOUT ) :: gam ! updated gamma + Integer, Intent( IN ) :: ist ! Soil Type + Integer, Intent( IN ) :: dt ! time step in s + Integer, Intent( IN ) :: C ! Column + Integer, Intent( IN ) :: R ! Row + + Real :: fTg ! nitrification temperature factor + Real :: fSWg ! nitrification Soil Water factor + Real :: fpHg ! nitrification pH factor + Real :: Kn ! nitrification rate 1/s + Real :: Kvs ! Air-soil exchange rate for aqueous NH4+ + Real :: kvg ! Air-soil exchange rate for gas phase NH3 + Real :: MNH3 ! molar atmospheric NH3 conc. + Real :: MNHx ! molar soil water NH4+ + NH3 conc. + Real :: wg25 ! wilting point +0.25*(field capacity-wilting point) + Real :: pHsl ! Soil pH + Real :: ag_tot ! total + Integer :: i ! loop counter + CHARACTER( 96 ) :: xmsg = ' ' + Character( 16 ), Parameter :: pname = 'Calc_Nitrif' + +! convert the ambient concentrations from ppm to mol/l + MNH3 = CNH3c / 24.45 * 1.0e-6 + +! Get the soil pH + pHsl = -log10( MHp ) + +! get NH4+ from gamma ([NH4+]/[H+] with units in mol/l) + MNHx = min( gam / wg, 2.0e5 ) * MHp + +! Estimate the soil nitrification rate following Reddy et al 1979 starting with +! the temperature parameter + fTg = max( 0.041 * ( Tempg - 278.15 ), 0.0 ) + +! Estimate the soil water parameter + wg25 = wwlt( ist ) + 0.25 * ( wfc( ist ) - wwlt( ist ) ) + If ( wg .Le. wwlt( ist ) ) fSWg = 0.1 + If ( wg .Lt. wg25 .And. wg .Gt. wwlt( ist ) ) Then + fSWg = max( 0.1, 0.1 + 0.9 * Sqrt( ( wg - wwlt( ist ) ) / + & ( wfc( ist ) - wwlt( ist ) ) ), ( wg - wwlt( ist ) ) / + & ( 0.25 * ( wfc( ist ) - wwlt( ist ) ) ) ) + End If + If ( wg .Ge. wg25 .And. wg .Lt. wfc( ist ) ) fSWg = 1.0 + + If ( wg .Ge. wfc( ist ) ) Then + fSWg = max( 0.1, 1.0 - ( wg - wfc( ist ) ) / ( wsat( ist )-wfc( ist ) ) ) + End If +! Estimate the pH factor + If ( pHsl .Lt. 7.0 ) fpHg = 0.307 * pHsl - 1.269 + If ( pHsl .Ge. 7.0 .And. pHsl .Lt. 7.4 ) fpHg = 1.0 + If ( pHsl .Ge. 7.4) fpHg = 5.367 - 0.599 * pHsl + + Kn = fTg * fSWg * fpHg / 24.0 / 3600.0 ! Kn is in 1/d in EPIC +! Estimate the soil evasion rate + kvg = 0.0 + Kvs = 0.0 + ag_tot = 0.0 + Do i = 1, n_lufrac + If ( lufrac(i,c,r) .Gt. 0.0 ) Then + Select Case( cat_lu( i ) ) + Case('AG','AGMOS' ) + kvg = kvg + gg( i ) / ( wg * real( ds, 8 ) ) * lufrac( i,c,r ) + Kvs = Kvs + ( 161512.0d0 / real( tempg, 8 ) + & * 10.0d0**( -4507.11d0 / real( tempg, 8 ) ) ) + & * gg( i ) / ( wg * real( ds, 8 ) ) / mhp * lufrac( i,c,r ) + ag_tot = ag_tot + lufrac( i,c,r ) + End Select + End If + End Do + If ( ag_tot .Gt. 0.0 ) Then + kvg = kvg / ag_tot + Kvs = Kvs / ag_tot + MNHx = kvg * MNH3 / ( Kvs + Kn ) + ( MNHx - kvg * MNH3 / ( Kvs + Kn ) ) + & * exp( - ( Kvs + Kn ) * dt ) + gam = MNHx / MHp * wg + max( gam / wg - maxgam, 0.0 ) * wg + Else + gam = natgam + End If + + If ( IsNaN( gam ) ) Then + xmsg = 'NaN in Gamma Calculation' + Write( logdev,* ) 'MNHx :', MNHx + Write( logdev,* ) 'gam :', gam + Write( logdev,* ) 'MHp :', MHp + Write( logdev,* ) 'ag_tot :', ag_tot + Call M3exit( pname, 0, 0, xmsg, xstat1) + End If + + Return + End Subroutine Calc_Nitrif + + Logical Function IsNaN( a ) ! required for Portland Group compiler (pgi) + Real :: a + If ( a .Eq. a ) Then ! requires -Kieee flag for pgi +! write( *,* ) '==IsNaN false: ', a + IsNaN = .false. + Else +! write( *,* ) '==IsNaN true: ', a + IsNaN = .true. + End If + Return + End Function IsNaN ! error, if pgf90 +! End ! error, if ifort + + End Module ABFlux_Mod diff --git a/models/CCTM/depv/blank/BIDI_MOD.F b/models/CCTM/depv/blank/BIDI_MOD.F new file mode 100755 index 0000000..20c87a8 --- /dev/null +++ b/models/CCTM/depv/blank/BIDI_MOD.F @@ -0,0 +1,266 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/BIDI_MOD.F,v 1.4 2012/01/19 14:21:03 yoj Exp $ + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module Bidi_Mod + +C Contains the shared variables and subrountes needed for the bidirectional +C NH3 flux model in CMAQ +C +C OPASX_MEDIA - Opens the output file for NH4+ and H+ in the soil water solution +C +C Revision History: J. Bash Mar 15 11: Created +C J. Bash May 11 11: Updated for CMAQ 5.0 + + Implicit None +! Private variables + Integer, Parameter, Private :: NHx_AQ_CONC = 4 + Integer, Parameter, Private :: NHx_GAS_CONC = 0 + Integer, Parameter, Private :: NHx_SOL_CONC = 0 + Integer, Parameter, Private :: NHx_TOT = NHx_AQ_CONC + NHx_GAS_CONC + NHx_SOL_CONC + Integer, Save, Private :: LOGDEV + Character( 96 ), Private :: XMSG = ' ' +! shared variables + Character( 16 ), Save , Allocatable :: MEDIA_NAMES( : ) + Character( 16 ), Save , Allocatable :: MEDIA_UNITS( : ) + Character( 80 ), Save , Allocatable :: MEDIA_DESCR( : ) + Integer, Save :: N_TOT + Real, Save, Allocatable :: gamma1( :,: ) ! soil NH4/H + Real, Save, Allocatable :: gamma2( :,: ) ! soil NH4/H + Real, Save, Allocatable :: MHp1 ( :,: ) ! molar H+ + Real, Save, Allocatable :: MHp2 ( :,: ) ! molar H+ + Real, Save, Allocatable :: CMEDIA( :,:,: ) ! surface layer concs + Real, Save, Allocatable :: lufrac( :,:,: ) + + Contains + SUBROUTINE INIT_BIDI( abflux ) + USE GRID_CONF + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + + IMPLICIT NONE + + LOGICAL, INTENT( IN ) :: abflux + CHARACTER( 16 ) :: PNAME = 'INIT_BIDI ' + CHARACTER( 80 ) :: VARDESC + CHARACTER( 96 ) :: MSG = ' ' + + N_TOT = NHx_TOT +! Write( Logdev,* ), 'N_TOT', N_TOT +! Write( Logdev,* ), 'NHx_TOT', NHx_TOT + ALLOCATE( MEDIA_NAMES( N_TOT ), MEDIA_UNITS( N_TOT ), MEDIA_DESCR( N_TOT ) ) + + MEDIA_NAMES( 1 ) = 'Gamma1 ' + MEDIA_UNITS( 1 ) = ' ' + MEDIA_DESCR( 1 ) = 'NH4+/H+ in Soil layer 1' + MEDIA_NAMES( 2 ) = 'Gamma2 ' + MEDIA_UNITS( 2 ) = ' ' + MEDIA_DESCR( 2 ) = 'NH4+/H+ in Soil layer 2' + MEDIA_NAMES( 3 ) = 'MHpsl1 ' + MEDIA_UNITS( 3 ) = 'mol/l ' + MEDIA_DESCR( 3 ) = 'Molar H+ in Soil layer 1' + MEDIA_NAMES( 4 ) = 'MHpsl2 ' + MEDIA_UNITS( 4 ) = 'mol/l ' + MEDIA_DESCR( 4 ) = 'Molar H+ in Soil layer 2' + + ! allocate the media array variable + IF ( .NOT. ALLOCATED ( CMEDIA ) ) THEN + ALLOCATE ( CMEDIA( NCOLS,NROWS,N_TOT ) ) + CMEDIA = 0.0 ! array assignment + END IF + + RETURN + + END SUBROUTINE INIT_BIDI +!----------------------------------------------------------------------------- +!-------------- Iput / output section of the module -------------------------- +!----------------------------------------------------------------------------- + + SUBROUTINE OPASX_MEDIA( JDATE, JTIME, TSTEP ) + + USE GRID_CONF + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + + IMPLICIT NONE + + INCLUDE SUBST_FILES_ID ! file name parameters + + INTEGER, INTENT( IN ) :: JDATE + INTEGER, INTENT( IN ) :: JTIME + INTEGER, INTENT( IN ) :: TSTEP + + CHARACTER( 16 ) :: PNAME = 'OPASX_MEDIA' + CHARACTER( 80 ) :: VARDESC + CHARACTER( 96 ) :: MSG = ' ' + + INTEGER N, V, L + +C-------------------------------------------------------------------------- + LOGDEV = INIT3() + +! Write( logdev,* ) 'In ', PNAME + IF ( .NOT. OPEN3( MEDIA_CONC, FSRDWR3, PNAME ) ) THEN + +! Write( logdev,* ) 'After Open3' +! Write( logdev,* ) 'N_TOT', N_TOT +! Write( logdev,* ) 'JDATE', JDATE +! Write( logdev,* ) 'JTIME', JTIME + XMSG = 'Could not open ' // MEDIA_CONC // ' file for update - ' + & // 'try to open new' + CALL M3MESG( XMSG ) + + FTYPE3D = GRDDED3 + SDATE3D = JDATE + STIME3D = JTIME + TSTEP3D = TSTEP + CALL NEXTIME( SDATE3D, STIME3D, TSTEP3D ) ! start the next hour + + NVARS3D = N_TOT + 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 +! Write( logdev,* ) 'NLAYS3D', NLAYS3D + DO L = 1, NLAYS3D + 1 + VGLVS3D( L ) = VGLVS_GD( L ) + END DO + GDNAM3D = GRID_NAME ! from HGRD_DEFN + + FDESC3D = ' ' ! array assignment + + FDESC3D( 1 ) = 'Multimedia concentration estimates from integrated ambient ' + & // 'concentraitons and surface exchange algorithms' + + N = 0 + + DO V = 1, NHx_AQ_CONC + N = N + 1 +! Write( logdev,* ) 'MEDIA NAME: ', MEDIA_NAMES( N ) + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = MEDIA_NAMES( N ) + UNITS3D( N ) = MEDIA_UNITS( N ) + VDESC3D( N ) = MEDIA_DESCR( N ) + END DO + + N = NHx_AQ_CONC + + DO V = 1, NHx_GAS_CONC + N = N + 1 +! Write( logdev,* ) 'MEDIA NAME: ', MEDIA_NAMES( N ) + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = MEDIA_NAMES( N ) + UNITS3D( N ) = 'ppmV g' + VDESC3D( N ) = 'gas phase concentration' + END DO + + N = NHx_AQ_CONC + NHx_GAS_CONC + + DO V = 1, NHx_SOL_CONC + N = N + 1 +! Write( logdev,* ) 'MEDIA NAME: ', MEDIA_NAMES( N ) + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = MEDIA_NAMES( N ) + UNITS3D( N ) = 'umol/g' + VDESC3D( N ) = 'Solid phase concentration' + END DO + END IF + +! Open file, then close it for subsequent open by all processors + +! Write( logdev,* ) 'Before Open3 MEDIA_CONC' + IF ( .NOT. OPEN3( MEDIA_CONC, FSNEW3, PNAME ) ) THEN + XMSG = 'Could not create '// TRIM( MEDIA_CONC) // ' file' + CALL M3EXIT( PNAME, SDATE3D, STIME3D, XMSG, XSTAT1 ) + END IF + + RETURN + + END SUBROUTINE OPASX_MEDIA + +!---------------------------------------------------------------------------- + + SUBROUTINE WRASX_MEDIA( MDATE, MTIME ) + + USE GRID_CONF ! horizontal grid specifications + USE UTILIO_DEFN + + IMPLICIT NONE + + INCLUDE SUBST_FILES_ID ! file name parameters + + INTEGER, INTENT( IN ) :: MDATE + INTEGER, INTENT( IN ) :: MTIME + + REAL :: WRMC( NCols,NRows ) ! media write buffer + INTEGER V, R, C + + CHARACTER( 16 ) :: PNAME = 'WRASX_MEDIA' + +!----------------------------------------------------------------------------- + LOGDEV = INIT3() + + Do R = 1, My_NRows + Do C = 1, My_NCols + CMedia( C,R,1 ) = Gamma1( C,R ) + CMedia( C,R,2 ) = Gamma2( C,R ) + CMedia( C,R,3 ) = MHp1( C,R ) + CMedia( C,R,4 ) = MHp2( C,R ) + End Do + End Do + + DO V = 1, N_TOT ! species/media loop + DO R = 1, My_NRows + DO C = 1, My_NCols + WRMC( C,R ) = CMEDIA( C,R,V ) + END DO + END DO + + IF ( .NOT. WRITE3( MEDIA_CONC, MEDIA_NAMES( V ), MDATE, MTIME, + & WRMC ) ) THEN + XMSG = 'Could not write ' // MEDIA_CONC // ' file' + CALL M3EXIT( PNAME, MDATE, MTIME, XMSG, XSTAT1 ) + END IF + + END DO + + WRITE( LOGDEV, '( /5X, A, I8, ":", I6.6 / )' ) + & 'Timestep written to "' // TRIM( MEDIA_CONC ) // + & '" for date and time', MDATE, MTIME + + RETURN + + END SUBROUTINE WRASX_MEDIA + End Module Bidi_Mod diff --git a/models/CCTM/depv/blank/DEPVVARS.F b/models/CCTM/depv/blank/DEPVVARS.F new file mode 100755 index 0000000..265e356 --- /dev/null +++ b/models/CCTM/depv/blank/DEPVVARS.F @@ -0,0 +1,140 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/DEPVVARS.F,v 1.7 2012/01/19 14:21:45 yoj Exp $ + +C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE DEPVVARS + +C----------------------------------------------------------------------- +C Name: Dry Deposition Variables +C Purpose: Contains arrays specific to dry deposition species. +C Initializes dry deposition arrays. +C Revised: 19 Aug 2005 Original version. (T. Otte and W. Hutzell) +C 25 Nov 2006 J.Young: combine +C 30 Apr 2008 Removed references to RADMDRY. Added five air +C toxic species to LTOTG. (T. Otte and W. Hutzell) +C 16 Feb 2011 S.Roselle: replaced I/O API include files with +C UTILIO_DEFN +C 11 May 2011 J.Bash: Updated for NH3 bidirectional exchange +C 04 Jan 2012 J.Young: Initialize char variables with blank padding +C----------------------------------------------------------------------- + + INTEGER, PARAMETER :: LDDEP = 4 + INTEGER, PARAMETER :: LTOTG = 52 + INTEGER, PARAMETER :: LCMP = 8 + CHARACTER( 16 ) :: DEPV_METHOD + +C----------------------------------------------------------------------- +C General dry deposition arrays. +C----------------------------------------------------------------------- + + INTEGER, SAVE :: N_USE_DEPSPC + LOGICAL, SAVE :: USE_DEPSPC( LTOTG ) + CHARACTER( 16 ), SAVE :: DEPSPC( LTOTG ) + +C---------------------------------------------------------------------- +C local deposition velocites [ m/s ] +C---------------------------------------------------------------------- + + CONTAINS + + FUNCTION DEPVVARS_INIT( ) RESULT ( SUCCESS ) + + USE HGRD_DEFN + USE UTILIO_DEFN + + IMPLICIT NONE + + LOGICAL SUCCESS + + INTEGER ALLOCSTAT + CHARACTER( 96 ) :: XMSG + + SUCCESS = .TRUE. + +C------------------------------------------------------------------------------- +C For M3DRY, set up core species, and include toxic and chlorine compounds. +C------------------------------------------------------------------------------- + + DEPV_METHOD = 'M3DRY ' + + DEPSPC( 1 ) = 'SO2 ' + DEPSPC( 2 ) = 'SULF ' + DEPSPC( 3 ) = 'NO2 ' + DEPSPC( 4 ) = 'NO ' + DEPSPC( 5 ) = 'O3 ' + DEPSPC( 6 ) = 'HNO3 ' + DEPSPC( 7 ) = 'H2O2 ' + DEPSPC( 8 ) = 'ALD ' + DEPSPC( 9 ) = 'HCHO ' + DEPSPC( 10 ) = 'OP ' + DEPSPC( 11 ) = 'PAA ' + DEPSPC( 12 ) = 'ORA ' + DEPSPC( 13 ) = 'NH3 ' + DEPSPC( 14 ) = 'PAN ' + DEPSPC( 15 ) = 'HONO ' + DEPSPC( 16 ) = 'CO ' + DEPSPC( 17 ) = 'METHANOL ' + DEPSPC( 18 ) = 'N2O5 ' + DEPSPC( 19 ) = 'NO3 ' + DEPSPC( 20 ) = 'GEN_ALD ' + DEPSPC( 21 ) = 'CL2 ' + DEPSPC( 22 ) = 'HOCL ' + DEPSPC( 23 ) = 'HCL ' + DEPSPC( 24 ) = 'FMCL ' + DEPSPC( 25 ) = 'HG ' + DEPSPC( 26 ) = 'HGIIGAS ' + DEPSPC( 27 ) = 'TECDD_2378 ' + DEPSPC( 28 ) = 'PECDD_12378 ' + DEPSPC( 29 ) = 'HXCDD_123478 ' + DEPSPC( 30 ) = 'HXCDD_123678 ' + DEPSPC( 31 ) = 'HXCDD_123789 ' + DEPSPC( 32 ) = 'HPCDD_1234678 ' + DEPSPC( 33 ) = 'OTCDD ' + DEPSPC( 34 ) = 'TECDF_2378 ' + DEPSPC( 35 ) = 'PECDF_12378 ' + DEPSPC( 36 ) = 'PECDF_23478 ' + DEPSPC( 37 ) = 'HXCDF_123478 ' + DEPSPC( 38 ) = 'HXCDF_123678 ' + DEPSPC( 39 ) = 'HXCDF_234678 ' + DEPSPC( 40 ) = 'HXCDF_123789 ' + DEPSPC( 41 ) = 'HPCDF_1234678 ' + DEPSPC( 42 ) = 'HPCDF_1234789 ' + DEPSPC( 43 ) = 'OTCDF ' + DEPSPC( 44 ) = 'NAPHTHALENE ' + DEPSPC( 45 ) = '1NITRONAPHTHA ' + DEPSPC( 46 ) = '2NITRONAPHTHA ' + DEPSPC( 47 ) = '14NAPHTHOQUIN ' + DEPSPC( 48 ) = 'HEXMETH_DIIS ' + DEPSPC( 49 ) = 'HYDRAZINE ' + DEPSPC( 50 ) = 'MAL_ANHYDRIDE ' + DEPSPC( 51 ) = 'TOLUENE_DIIS ' + DEPSPC( 52 ) = 'TRIETHYLAMINE ' + + N_USE_DEPSPC = 0 + USE_DEPSPC = .FALSE. ! array + + RETURN + + END FUNCTION DEPVVARS_INIT + + END MODULE DEPVVARS diff --git a/models/CCTM/depv/blank/DEPV_DEFN.F b/models/CCTM/depv/blank/DEPV_DEFN.F new file mode 100755 index 0000000..acbaa5c --- /dev/null +++ b/models/CCTM/depv/blank/DEPV_DEFN.F @@ -0,0 +1,1209 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/DEPV_DEFN.F,v 1.12 2012/01/19 14:22:45 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE DEPV_DEFN + +C----------------------------------------------------------------------- +C Function: deposition velocity interface to the chemistry-transport model + +C Revision History: +C 24 Nov 2006 J.Young: initial implementation using Bill Hutzell's and +C Tanya Otte's work +C 29 Jan 2010 D. Wong: Eliminate potential race condition at the MYPE = 0 +C to open the diagnostic file. Eliminate the BARRIER +C and the CLOSE3 and OPEN3. +C 21 Jun 2010 J.Young: convert for Namelist redesign +C 27 Jan 2011 J.Young: remove references to AERO3 and AERO4 +C 20 Jan 2011 J. Bash: Passed the component fluxes and tstep between vdiff +C & m3dry +C 16 Feb 2011 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C 5 May 2011 J.Young: remove writing diagnostic output for initial call +C 22 Sep 2011 D. Wong: - incorporated twoway model implemenation +C - used a robust way to compute WTIME +C 11 Oct 2011 J.Young: PUBLIC/PRIVATE sections, re-do WTIME computation +C and WTIME computation for MOSAIC +C 13 Dec 2011 J.Young: removed separate SOA variables - no longer used +C 18 Sep 2012 D. Wong: invoke INIT_LSM regardless of MOSAIC or ABFLUX option +C----------------------------------------------------------------------- + + IMPLICIT NONE + +C model depositon velocites array + REAL, ALLOCATABLE, SAVE :: DEPV( :,:,: ) + +C model depositon velocites array by land use category + REAL, ALLOCATABLE, SAVE :: DEPVJ( :,:,:,: ) + +C model depositon velocites array by land use category + REAL, ALLOCATABLE, SAVE :: DEPVJ_FST( :,:,:,: ) + +C no. of deposition velocity model species + INTEGER, SAVE :: N_SPC_DEPV + +C ddep spc conversion factors + REAL, ALLOCATABLE, SAVE :: DD_CONV( : ) + +C model-oriented bi-directional production [ppm-m/s] + REAL, ALLOCATABLE, SAVE :: PLDV( :,:,: ) + REAL, ALLOCATABLE, SAVE :: CMP ( :,:,: ) + +C flag in-lining depv + LOGICAL, SAVE :: ILDEPV + +C flag for HONO interaction with surfaces within in-lining depv + LOGICAL, SAVE :: SFC_HONO = .FALSE. + +C flag for ammonia bi-directional flux with in-lining depv + LOGICAL, SAVE :: ABFLUX + +C flag for mosaic - luc specific deposition - within in-lining depv + LOGICAL, SAVE :: MOSAIC = .FALSE. + +C flag for mosaic - luc specific deposition - stomatal flux only - within in-lining depv + LOGICAL, SAVE :: FST = .FALSE. + + PUBLIC DEPV, DEPVJ, DEPVJ_FST, N_SPC_DEPV, DD_CONV, PLDV, CMP, + & ILDEPV, SFC_HONO, ABFLUX, MOSAIC, FST, + & DEPV_INIT, GET_DEPV + PRIVATE + +C gas species (gas-phase and gas non-reactive) deposition velocities + REAL, ALLOCATABLE, SAVE :: DEPVEL_GAS( :,:,: ) + +C m3dry-oriented bi-directional production [ppm-m/s] + REAL, ALLOCATABLE, SAVE :: PVD( :,:,: ) + +C CGRID for m3dry bi-directional flux calculation + REAL, ALLOCATABLE, SAVE :: CGRIDL1( :,:,: ) + +C flag for diagnostic DEPV file + LOGICAL, SAVE :: DEPV_DIAG + INTEGER, SAVE :: SDATE, STIME + + INTEGER, SAVE :: N_UNIQUE_GDEPV ! gas depv + CHARACTER( 16 ), ALLOCATABLE, SAVE :: UNIQUE_GDEPV( : ) + INTEGER, ALLOCATABLE, SAVE :: GAS_DEPV_SUR( : ) + LOGICAL, ALLOCATABLE, SAVE :: GAS_DEPV_FOUND( : ) + + INTEGER, SAVE :: N_UNIQUE_ADEPV ! aero depv + CHARACTER( 16 ), ALLOCATABLE, SAVE :: UNIQUE_ADEPV( : ) + INTEGER, ALLOCATABLE, SAVE :: AER_DEPV_SUR( : ) + + INTEGER, SAVE :: NR_OFFSET ! Offset to NR start in CGRID + INTEGER, SAVE :: N_GAS_DEPV + + REAL, ALLOCATABLE, SAVE :: ADEPV( :,:,: ) ! Aerosol dep vel from + ! subroutine AERO_DEPV + REAL, ALLOCATABLE, SAVE :: DBUFF( :,: ) ! diagnostic output buffer + REAL, ALLOCATABLE, SAVE :: DBUFF3( :,:,: ) ! diagnostic output buffer with 3 dimensions + + INTEGER :: GXOFF, GYOFF ! global origin offset from file +C for INTERPX + INTEGER, SAVE :: STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + + REAL, ALLOCATABLE, SAVE :: UCROSS( :,:,:) + REAL, ALLOCATABLE, SAVE :: VCROSS( :,:,:) + REAL, ALLOCATABLE, SAVE :: DLUSE( :,: ) + + CONTAINS + +C----------------------------------------------------------------------- + FUNCTION DEPV_INIT( JDATE, JTIME, TSTEP, CGRID ) RESULT ( SUCCESS ) + + USE HGRD_DEFN + USE CGRID_SPCS ! CGRID mechanism species + USE DEPVVARS + USE UTILIO_DEFN + USE MOSAIC_MOD, Only: Init_Mosaic + USE LSM_MOD, Only: Init_LSM, n_lufrac + USE BIDI_MOD, Only: Init_Bidi + + IMPLICIT NONE + +C Includes: + INCLUDE SUBST_RXCMMN ! Mechanism reaction common block (for MECHNAME) + INCLUDE SUBST_CONST ! constants + INCLUDE SUBST_FILES_ID ! file name parameters + +C Arguments: + INTEGER JDATE, JTIME, TSTEP( 3 ) + REAL, POINTER :: CGRID( :,:,:,: ) + LOGICAL SUCCESS + +C External Functions: + INTEGER, EXTERNAL :: FINDEX ! finds index of a number in a list + +C Parameters: + REAL, PARAMETER :: RGAS1 = 1.0 / RGASUNIV ! univ. gas constant reciprocal + REAL, PARAMETER :: M2PHA = 1.0E+04 ! 1 hectare = 1.0e4 m**2 + REAL, PARAMETER :: CMLMR = 1.0E+06 ! ppmV/Molar Mixing Ratio + REAL, PARAMETER :: CNVTD = M2PHA / CMLMR / MWAIR ! combined ddep conv factor + +C Local variables: + CHARACTER( 16 ), ALLOCATABLE :: ALL_GAS_DEPV( : ) + LOGICAL, ALLOCATABLE :: AE_DEPV_FOUND( : ) + +C environment variable for in-line DEPV + CHARACTER( 16 ) :: CTM_ILDEPV = 'CTM_ILDEPV ' + +C environment variable for ammonia bi-directional flux + CHARACTER( 16 ) :: CTM_ABFLUX = 'CTM_ABFLUX ' + +C environment variable for HONO interaction with surfaces + CHARACTER( 16 ) :: CTM_SFC_HONO = 'CTM_SFC_HONO ' + +C environment variable for mosaic - luc specific deposition velocities + CHARACTER( 16 ) :: CTM_MOSAIC = 'CTM_MOSAIC ' + +C environment variable for mosaic - luc specific stomatal flux + CHARACTER( 16 ) :: CTM_FST = 'CTM_FST ' + +C variables for deposition velocities diagnostic file + INTEGER :: STATUS ! ENV... status + CHARACTER( 80 ) :: VARDESC ! environment variable description + +C environment variable for diagnostic DEPV file + CHARACTER( 16 ) :: CTM_DEPV_FILE = 'CTM_DEPV_FILE ' + + CHARACTER( 16 ) :: PNAME = 'DEPV_INIT ' + CHARACTER( 120 ) :: XMSG = ' ' + + INTEGER AE_OFFSET ! Offset to AE start in CGRID + INTEGER NDX, NDX2, NDX3 ! Temp index + INTEGER LOGDEV, ALLOCSTAT + INTEGER J, L, N, S, V, STRT + INTEGER, SAVE :: n_spc_m3dry = ltotg ! from DEPVVARS module + + INTERFACE + SUBROUTINE OPDEPV_DIAG ( JDATE, JTIME, TSTEP, + & N_GDEPV_NAMES, GDEPV_NAMES, + & N_ADEPV_NAMES, ADEPV_NAMES ) + USE HGRD_DEFN + USE DEPVVARS + USE UTILIO_DEFN + IMPLICIT NONE + INTEGER, INTENT( IN ) :: JDATE, JTIME, TSTEP + INTEGER, INTENT( IN ) :: N_GDEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: GDEPV_NAMES( : ) + INTEGER, INTENT( IN ) :: N_ADEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: ADEPV_NAMES( : ) + END SUBROUTINE OPDEPV_DIAG + SUBROUTINE OPDEPV_MOS ( JDATE, JTIME, TSTEP, + & N_GDEPV_NAMES, GDEPV_NAMES, + & N_ADEPV_NAMES, ADEPV_NAMES ) + USE HGRD_DEFN + USE DEPVVARS + USE UTILIO_DEFN + IMPLICIT NONE + INTEGER, INTENT( IN ) :: JDATE, JTIME, TSTEP + INTEGER, INTENT( IN ) :: N_GDEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: GDEPV_NAMES( : ) + INTEGER, INTENT( IN ) :: N_ADEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: ADEPV_NAMES( : ) + END SUBROUTINE OPDEPV_MOS + SUBROUTINE OPDEPV_FST ( JDATE, JTIME, TSTEP, + & N_GDEPV_NAMES, GDEPV_NAMES, + & N_ADEPV_NAMES, ADEPV_NAMES ) + USE HGRD_DEFN + USE DEPVVARS + USE UTILIO_DEFN + IMPLICIT NONE + INTEGER, INTENT( IN ) :: JDATE, JTIME, TSTEP + INTEGER, INTENT( IN ) :: N_GDEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: GDEPV_NAMES( : ) + INTEGER, INTENT( IN ) :: N_ADEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: ADEPV_NAMES( : ) + END SUBROUTINE OPDEPV_FST + SUBROUTINE GAS_DEPV_MAP ( N_DEPV_NAMES, DEPV_NAMES, DEPV_SUR ) + USE CGRID_SPCS + USE DEPVVARS + USE UTILIO_DEFN + IMPLICIT NONE + INTEGER, INTENT( IN ) :: N_DEPV_NAMES + CHARACTER( 16 ), INTENT( INOUT ) :: DEPV_NAMES( : ) + INTEGER, INTENT( OUT ) :: DEPV_SUR( : ) + END SUBROUTINE GAS_DEPV_MAP + END INTERFACE + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + + SUCCESS = .TRUE. + + SDATE = JDATE; STIME = JTIME + + N_GAS_DEPV = N_GC_DEPV + N_NR_DEPV + N_TR_DEPV + N_SPC_DEPV = N_GAS_DEPV + N_AE_DEPV + + ALLOCATE ( DEPV( N_SPC_DEPV+1,NCOLS,NROWS ), + & PLDV( N_SPC_DEPV,NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DEPV or PLDV arrays' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + +C DEPVEL_GAS is used also for non-ILDEPV in the sgtot calculation + ALLOCATE ( DEPVEL_GAS( N_GAS_DEPV,NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DEPVEL_GAS array' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + +C Initialize deposition velocities for nondeposited species to zero: +C setting DEPV( N_SPC_DEPV+1,C,R ) = 0.0 accounts for dry dep. species names +C as a subset of the vert. diffused species list + DEPV = 0.0 ! array assignment + PLDV = 0.0 ! array assignment + + ALLOCATE ( DD_CONV( N_SPC_DEPV+1 ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DD_CONV' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + +C set dry dep conversion factor (done here so that vdiff doesn`t need the include files) + S = 0 + DO V = 1, N_GC_DEPV + S = S + 1 + DD_CONV( S ) = CNVTD * GC_MOLWT( GC_DEPV_MAP( V ) ) + END DO + + DO V = 1, N_AE_DEPV + S = S + 1 + IF ( AE_SPC( AE_DEPV_MAP( V ) )( 1:3 ) .EQ. 'NUM' ) THEN + DD_CONV( S ) = CNVTD * AVO * 1.0E+03 ! --> #/Ha + ELSE IF ( AE_SPC( AE_DEPV_MAP( V ) )( 1:3 ) .EQ. 'SRF' ) THEN + DD_CONV( S ) = M2PHA * 1.0E+03 / MWAIR ! --> M**2/Ha + ELSE + DD_CONV( S ) = CNVTD * AE_MOLWT( AE_DEPV_MAP( V ) ) + END IF + END DO + + DO V = 1, N_NR_DEPV + S = S + 1 + DD_CONV( S ) = CNVTD * NR_MOLWT( NR_DEPV_MAP( V ) ) + END DO + + DO V = 1, N_TR_DEPV + S = S + 1 + DD_CONV( S ) = CNVTD * TR_MOLWT( TR_DEPV_MAP( V ) ) + END DO + +C Initialize + IF ( N_AE_DEPV .GT. 0 ) THEN + ALLOCATE ( ADEPV( N_AE_DEPV,MY_NCOLS,MY_NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating ADEPV' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + END IF + + CALL SUBHFILE ( MET_CRO_2D, GXOFF, GYOFF, + & STRTCOLMC2, ENDCOLMC2, STRTROWMC2, ENDROWMC2 ) + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + +C In-line deposition velocities calculation? + ILDEPV = .TRUE. + VARDESC = 'Flag for in-line deposition velocities' + ILDEPV = ENVYN( CTM_ILDEPV, VARDESC, ILDEPV, 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 ( ILDEPV ) THEN + +C Pleim`s ammonia bi-directional flux with in-line deposition velocities calculation? + ABFLUX = .FALSE. + VARDESC = 'Flag for ammonia bi-directional flux calculation' + ABFLUX = ENVYN( CTM_ABFLUX, VARDESC, ABFLUX, 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 + +C Sarwar`s HONO interaction with leaf and building surfaces? + SFC_HONO = .TRUE. + VARDESC = 'Flag for HONO interaction with surfaces' + SFC_HONO = ENVYN( CTM_SFC_HONO, VARDESC, SFC_HONO, 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 + +C Mosaic method to get land-use specific deposition velocities? + MOSAIC = .FALSE. + VARDESC = 'Flag for land-use specific deposition velocity calculation' + MOSAIC = ENVYN( CTM_MOSAIC, VARDESC, MOSAIC, 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 + +C Mosaic method to get land-use specific stomatal flux + IF ( MOSAIC ) THEN + FST = .FALSE. + VARDESC = 'Flag for land-use specific stomatal flux calculation' + FST = ENVYN( CTM_FST, VARDESC, MOSAIC, 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 + END IF + + CALL INIT_LSM( JDATE, JTIME ) + IF ( ABFLUX ) CALL INIT_BIDI( ABFLUX ) + IF ( MOSAIC .OR. ABFLUX ) THEN + CALL INIT_MOSAIC( JDATE, JTIME, LTOTG, MOSAIC, ABFLUX ) + END IF +C Allocate additional arrays needed for mosaic and initialize land use parameters + IF ( MOSAIC ) THEN + + ALLOCATE ( DEPVJ( N_LUFRAC,N_SPC_DEPV+1,NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DEPVJ array' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + DEPVJ = 0.0 + + IF ( FST ) THEN + ALLOCATE ( DEPVJ_FST( N_LUFRAC,N_SPC_DEPV+1,NCOLS,NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DEPVJ_FST array' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + END IF + + END IF ! mosaic + + END IF ! in-line depv + + INIT_GAS_DV: + & IF ( N_GAS_DEPV .GT. 0 ) THEN + + ALLOCATE ( ALL_GAS_DEPV( N_GAS_DEPV ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating ALL_GAS_DEPV' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + + DO V = 1, N_GC_DEPV + ALL_GAS_DEPV( V ) = GC_DEPV( V ) + END DO + STRT = N_GC_DEPV + DO V = 1, N_NR_DEPV + ALL_GAS_DEPV( V + STRT ) = NR_DEPV( V ) + END DO + STRT = N_GC_DEPV + N_NR_DEPV + DO V = 1, N_TR_DEPV + ALL_GAS_DEPV( V + STRT ) = TR_DEPV( V ) + END DO + +C Identify and remove multiple occurrences of gas deposition velocities + ALLOCATE( GAS_DEPV_FOUND( N_GAS_DEPV ), + & GAS_DEPV_SUR ( N_GAS_DEPV ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating GAS_DEPV_FOUND or GAS_DEPV_SUR' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + + GAS_DEPV_FOUND = .FALSE. + N_UNIQUE_GDEPV = 0 + + LOOP_UNIQUE: + & DO N = 1, N_GAS_DEPV + IF ( GAS_DEPV_FOUND( N ) ) CYCLE LOOP_UNIQUE + DO V = 1, N_GAS_DEPV + IF ( ALL_GAS_DEPV( N ) .EQ. ALL_GAS_DEPV( V ) ) THEN + IF ( GAS_DEPV_FOUND( V ) ) CYCLE LOOP_UNIQUE + N_UNIQUE_GDEPV = N_UNIQUE_GDEPV + 1 + GAS_DEPV_FOUND( V ) = .TRUE. + CYCLE LOOP_UNIQUE + END IF + END DO + END DO LOOP_UNIQUE + + ALLOCATE( UNIQUE_GDEPV( N_UNIQUE_GDEPV ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating UNIQUE_GDEPV' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + +#ifdef Verbose + write( logdev,* ) ' ' + write( logdev,* ) ' All Gas DEPVs Requested Gas DEPV' +#endif + + V = 1 + DO N = 1, N_GAS_DEPV + IF ( GAS_DEPV_FOUND( N ) ) THEN + UNIQUE_GDEPV( V ) = ALL_GAS_DEPV( N ) +#ifdef Verbose + write( logdev,1019 ) n, all_gas_depv( n ), v, unique_gdepv( v ) +1019 format( 2x, i5, 1x, a16, 2x, i5, 1x, a16 ) +#endif + V = V + 1 +#ifdef Verbose + else + write( logdev,1019 ) n, all_gas_depv( n ), -1, ' ' +#endif + END IF + END DO + +C Get pointers to model species (GAS_DEPV_SUR) + CALL GAS_DEPV_MAP ( N_UNIQUE_GDEPV, UNIQUE_GDEPV, GAS_DEPV_SUR ) + +C Identify and remove multiple occurrences of aerosol deposition velocities + + ALLOCATE( AE_DEPV_FOUND( N_AE_DEPV ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating AE_DEPV_FOUND' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + AE_DEPV_FOUND = .FALSE. + N_UNIQUE_ADEPV = 0 + + AERO_UNIQUE: + & DO N = 1, N_AE_DEPV + IF ( AE_DEPV_FOUND( N ) ) CYCLE AERO_UNIQUE + DO V = 1, N_AE_DEPV + IF ( AE_DEPV( N ) .EQ. AE_DEPV( V ) ) THEN + IF ( AE_DEPV_FOUND( V ) ) CYCLE AERO_UNIQUE + N_UNIQUE_ADEPV = N_UNIQUE_ADEPV + 1 + AE_DEPV_FOUND( V ) = .TRUE. + CYCLE AERO_UNIQUE + END IF + END DO + END DO AERO_UNIQUE + + ALLOCATE( UNIQUE_ADEPV( N_UNIQUE_ADEPV ) ) + ALLOCATE( AER_DEPV_SUR( N_UNIQUE_ADEPV ) ) + +#ifdef Verbose + write( logdev,* ) ' ' + write( logdev,* ) ' Requested Aerosol DEPV and pointer' +#endif + + V = 1 + DO N = 1, N_AE_DEPV + IF ( AE_DEPV_FOUND( N ) ) THEN + UNIQUE_ADEPV( V ) = AE_DEPV( N ) + AER_DEPV_SUR( V ) = N +#ifdef Verbose + write( logdev,1021 ) n, v, unique_adepv( v ), aer_depv_sur( v ) +1021 format( 2i5, 1x, a16, i5 ) +#endif + V = V + 1 + END IF + END DO + +#ifdef Verbose + write( logdev,* ) ' ' +#endif + + IF ( ILDEPV ) THEN + ALLOCATE ( CGRIDL1( N_GAS_DEPV,NCOLS,NROWS ), + & PVD ( N_GAS_DEPV,NCOLS,NROWS ), + & CMP ( LCMP,NCOLS,NROWS),STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating CGRIDL1, CMP or PVD arrays' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + CGRIDL1 = 0.0 ! array assignment (PVD initalized in m3dry) + END IF + +C Get diagnostic file flag. + DEPV_DIAG = .FALSE. ! default + VARDESC = 'Flag for writing the DEPV diagnostic file' + DEPV_DIAG = ENVYN( CTM_DEPV_FILE, VARDESC, DEPV_DIAG, STATUS ) + IF ( STATUS .NE. 0 ) WRITE( LOGDEV, '(5X, A)' ) VARDESC + IF ( STATUS .EQ. 0 ) THEN + WRITE( LOGDEV,'( 5X, A )' ) VARDESC + XMSG = TRIM( PNAME ) // ': writes GAS DEPV values to ' + & // TRIM( CTM_DEPV_FILE ) + WRITE( LOGDEV,'( 5X, A )' ) XMSG + ELSE 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 + + END IF INIT_GAS_DV + + WRITE( LOGDEV,'( 5X, A / )' ) 'DEPV_INIT: completed INIT_GAS_DV block ' + + IF ( .NOT. ILDEPV ) THEN + + DEPV_DIAG = .FALSE. ! make sure to avoid bogus write attempt later + + ELSE ! ILDEPV + + IF ( DEPV_DIAG ) THEN + + ALLOCATE ( DBUFF( MY_NCOLS,MY_NROWS ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DBUFF' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + + IF ( MYPE .EQ. 0 ) THEN + CALL OPDEPV_DIAG ( JDATE, JTIME, TSTEP( 1 ), + & N_UNIQUE_GDEPV, UNIQUE_GDEPV, + & N_UNIQUE_ADEPV, UNIQUE_ADEPV ) + END IF + + END IF + + IF ( MOSAIC ) THEN + + ALLOCATE ( DBUFF3( MY_NCOLS,MY_NROWS,N_LUFRAC ), STAT = ALLOCSTAT ) + IF ( ALLOCSTAT .NE. 0 ) THEN + XMSG = 'Failure allocating DBUFF3' + CALL M3WARN( PNAME, JDATE, JTIME, XMSG ) + SUCCESS = .FALSE.; RETURN + END IF + + IF ( MYPE .EQ. 0 ) THEN + CALL OPDEPV_MOS ( JDATE, JTIME, TSTEP( 1 ), + & N_UNIQUE_GDEPV, UNIQUE_GDEPV, + & N_UNIQUE_ADEPV, UNIQUE_ADEPV ) + END IF + + IF ( FST ) THEN + + IF ( MYPE .EQ. 0 ) THEN + CALL OPDEPV_FST ( JDATE, JTIME, TSTEP( 1 ), + & N_UNIQUE_GDEPV, UNIQUE_GDEPV, + & N_UNIQUE_ADEPV, UNIQUE_ADEPV ) + END IF + + END IF ! FST + + END IF ! MOSAIC + + END IF + + END FUNCTION DEPV_INIT +C----------------------------------------------------------------------- + + + SUBROUTINE GET_DEPV( JDATE, JTIME, TSTEP, CGRID ) +C----------------------------------------------------------------------- + + USE HGRD_DEFN + USE CGRID_SPCS ! CGRID mechanism species + USE DEPVVARS + USE UTILIO_DEFN + USE Mosaic_Mod + USE BIDI_Mod, Only: lufrac + USE LSM_Mod, Only: n_lufrac + + IMPLICIT NONE + +C Arguments: + INTEGER, INTENT( IN ) :: JDATE, JTIME ! simulation date&time, tstep + INTEGER, INTENT( IN ) :: TSTEP( 3 ) ! time step vector (HHMMSS) + ! TSTEP(1) = local output step + ! TSTEP(2) = sciproc sync. step (chem) + ! TSTEP(3) = twoway model time step w.r.t. wrf time + ! step and wrf/cmaq call frequency + + REAL, POINTER :: CGRID( :,:,:,: ) ! concentrations + + INCLUDE SUBST_CONST ! constants + INCLUDE SUBST_FILES_ID ! file name parameters + +C Parameters: + REAL, PARAMETER :: RGAS1 = 1.0 / RGASUNIV ! univ. gas constant reciprocal + REAL, PARAMETER :: H_VAP = 156.0E+03 ! enthalpy of vaporization (J/mol) + REAL, PARAMETER :: TREF = 298.0 ! Reference temperature for Cstar + REAL, PARAMETER :: TREF1 = 1.0 / TREF ! Reciprocal ref temperature + +C Local variables: + INTEGER STRT, FINI + LOGICAL :: WRITE_TIME ! write to file flag + LOGICAL :: WRITE_TIME_MOS ! write to file flag + INTEGER, SAVE :: WSTEP = 0 ! local write counter [HHMMSS] + INTEGER, SAVE :: WSTEP_MOS = 0 ! local write counter [HHMMSS] + INTEGER :: CDATE, CTIME ! step beginning date and time + INTEGER :: WDATE, WTIME ! write date and time + + CHARACTER( 16 ) :: PNAME = 'GET_DEPV ' + CHARACTER( 120 ) :: XMSG = ' ' + + INTEGER C, R, N, V, NDX, J + INTEGER, SAVE :: LOGDEV + +#ifdef Verbose + integer cw, rw +#endif + + INTERFACE + SUBROUTINE RDDEPV ( JDATE, JTIME, DEPV ) + USE HGRD_DEFN + USE CGRID_SPCS + USE UTILIO_DEFN + IMPLICIT NONE + INTEGER, INTENT( IN ) :: JDATE, JTIME + REAL, INTENT( OUT ) :: DEPV( :,:,: ) + END SUBROUTINE RDDEPV + SUBROUTINE CGRID_DEPV( GAS_DEPV_FOUND, GAS_DEPV_SUR, CGRID, CGRIDL1 ) + USE HGRD_DEFN + USE CGRID_SPCS + USE UTILIO_DEFN + IMPLICIT NONE + LOGICAL, INTENT( IN ) :: GAS_DEPV_FOUND( : ) + INTEGER, INTENT( IN ) :: GAS_DEPV_SUR( : ) + REAL, POINTER :: CGRID( :,:,:,: ) + REAL, INTENT( OUT ) :: CGRIDL1( :,:,: ) + END SUBROUTINE CGRID_DEPV + SUBROUTINE M3DRY ( JDATE, JTIME, TSTEP, ABFLUX, SFC_HONO, MOSAIC, FST, + & CGRIDL1, DEPVEL_GAS, PVD, CMP ) + USE HGRD_DEFN + USE DEPVVARS + USE VGRD_DEFN + USE UTILIO_DEFN + USE SUBST_MODULES + Use ABFlux_Mod ! bidi NH3 exchange routines + Use LSM_Mod ! land surface model variables needed for mosaic and bidi + Use Mosaic_Mod ! contains mosaic routines + Use Bidi_Mod, Only: lufrac + IMPLICIT NONE + INTEGER, INTENT( IN ) :: JDATE, JTIME, TSTEP(3) + LOGICAL, INTENT( IN ) :: ABFLUX, SFC_HONO, MOSAIC, FST + REAL, INTENT( IN ) :: CGRIDL1( :,:,: ) + REAL, INTENT( OUT ) :: DEPVEL_GAS( :,:,: ), PVD( :,:,: ), CMP( :,:,: ) + END SUBROUTINE M3DRY + SUBROUTINE AERO_DEPV ( CGRID, JDATE, JTIME, TSTEP, MOSAIC, ADEPV ) + USE GRID_CONF + USE CGRID_SPCS + USE UTILIO_DEFN + USE AERO_DATA + USE SOA_DEFN + USE AEROMET_DATA + Use Mosaic_Mod, Only: ADEPVJ, USTARJ, RAJ ! contains mosaic routines + Use LSM_MOD, Only: N_LUFRAC + IMPLICIT NONE + REAL, POINTER :: CGRID( :,:,:,: ) + INTEGER, INTENT( IN ) :: JDATE, JTIME, TSTEP + LOGICAL, INTENT( IN ) :: MOSAIC + REAL, INTENT( OUT ) :: ADEPV( :,:,: ) + END SUBROUTINE AERO_DEPV + END INTERFACE + +C----------------------------------------------------------------------- + LOGDEV = INIT3() + + DEPV = 0.0 + + IF ( ILDEPV ) THEN +! Made default for Hg bidi JOB 9/12/11 + CALL CGRID_DEPV( GAS_DEPV_FOUND, GAS_DEPV_SUR, CGRID, CGRIDL1 ) + +! Write( logdev,* ) '==5 ', abflux, sfc_hono, mosaic, fst, +! & size ( depvel_gas ), size ( pvd ), size ( cmp ) + + CALL M3DRY ( JDATE, JTIME, TSTEP, ABFLUX, SFC_HONO, MOSAIC, FST, + & CGRIDL1, DEPVEL_GAS, PVD, CMP ) +#ifdef Verbose + cw = my_ncols/2; rw = my_nrows/2 +! cw = 17; rw = 43 + write( logdev,1033 ) cw, rw +1033 format( /5x, 'Depv diagnostics for my_col, my_row:', i4, ', ', i4 + & /6x, 'v', 3x, 'n', 1x, 'variable', 10x, 'ndx', + & 2x, 'depvel_gas', 4x, 'depv', 9x, 'pvd', 10x, 'pldv' ) +#endif + + N = 0 + STRT = 1 + FINI = N_GC_DEPV + DO V = STRT, FINI + N = N + 1 + NDX = GAS_DEPV_SUR( N ) + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DEPV( V,C,R ) = GC_DEPV_FAC( N ) * DEPVEL_GAS( NDX,C,R ) + PLDV( V,C,R ) = PVD( NDX,C,R ) +#ifdef Verbose + if ( c .eq. cw .and. r .eq. rw ) then + write( logdev,1039 ) v, n, gc_depv( n ), ndx, + & depvel_gas( ndx,c,r ), depv( v,c,r ), + & pvd( ndx,c,r ), pldv( v,c,r ) +1039 format( 3x, 2i4, 1x, a16, 1x, i3, 4( 1x, 1pe12.4 ) ) + end if +#endif + IF ( MOSAIC ) THEN + DO J = 1, N_LUFRAC + DEPVJ( J,V,C,R ) = GC_DEPV_FAC( N ) * DEPVEL_GASJ( J,NDX,C,R ) + IF ( FST ) + & DEPVJ_FST( J,V,C,R ) = GC_DEPV_FAC( N ) * VD_FST_GASJ( J,NDX,C,R ) + END DO + END IF + END DO + END DO + + END DO + + N = 0 + STRT = N_GC_DEPV + N_AE_DEPV + 1 + FINI = N_GC_DEPV + N_AE_DEPV + N_NR_DEPV + DO V = STRT, FINI + N = N + 1 + NDX = GAS_DEPV_SUR( N+N_GC_DEPV ) + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DEPV( V,C,R ) = NR_DEPV_FAC( N ) * DEPVEL_GAS( NDX,C,R ) + PLDV( V,C,R ) = PVD( NDX,C,R ) +#ifdef Verbose + if ( c == cw .and. r == rw ) then + write( logdev,1039 ) v, n, nr_depv( n ), ndx, + & depvel_gas( ndx,c,r ), depv( v,c,r ), + & pvd( ndx,c,r ), pldv( v,c,r ) + end if +#endif + IF ( MOSAIC ) THEN + DO J = 1, N_LUFRAC + DEPVJ( J,V,C,R ) = NR_DEPV_FAC( N ) * DEPVEL_GASJ( J,NDX,C,R ) + IF ( FST ) + & DEPVJ_FST( J,V,C,R ) = NR_DEPV_FAC( N ) * VD_FST_GASJ( J,NDX,C,R ) + END DO + END IF + END DO + END DO + END DO + + N = 0 + STRT = N_GC_DEPV + N_AE_DEPV + N_NR_DEPV + 1 + FINI = N_GC_DEPV + N_AE_DEPV + N_NR_DEPV + N_TR_DEPV + DO V = STRT, FINI + N = N + 1 + NDX = GAS_DEPV_SUR( N + N_GC_DEPV + N_NR_DEPV ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DEPV( V,C,R ) = TR_DEPV_FAC( N ) * DEPVEL_GAS( NDX,C,R ) + PLDV( V,C,R ) = PVD( NDX,C,R ) +#ifdef Verbose + if ( c == cw .and. r == rw ) then + write( logdev,1039 ) v, n, tr_depv( n ), ndx, + & depvel_gas( ndx,c,r ), depv( v,c,r ), + & pvd( ndx,c,r ), pldv( v,c,r ) + end if +#endif + IF ( MOSAIC ) THEN + DO J = 1, N_LUFRAC + DEPVJ( J,V,C,R ) = TR_DEPV_FAC( N ) * DEPVEL_GASJ( J,NDX,C,R ) + IF ( FST ) + & DEPVJ_FST( J,V,C,R ) = TR_DEPV_FAC( N ) * VD_FST_GASJ( J,NDX,C,R ) + END DO + END IF + END DO + END DO + + END DO + + ELSE + + CALL RDDEPV ( JDATE, JTIME, DEPV ) + + END IF ! in-line depv + + IF ( N_AE_DEPV .GT. 0 ) THEN + CALL AERO_DEPV( CGRID, JDATE, JTIME, TSTEP( 1 ), MOSAIC, ADEPV ) + + STRT = N_GC_DEPV + 1 + FINI = N_GC_DEPV + N_AE_DEPV + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + N = 0 + DO V = STRT, FINI + N = N + 1 + DEPV( V,C,R ) = AE_DEPV_FAC( N ) * ADEPV( N,C,R ) + IF ( ILDEPV .AND. MOSAIC ) THEN + DO J = 1, N_LUFRAC + DEPVJ( J,V,C,R ) = AE_DEPV_FAC( N ) * ADEPVJ( J,N,C,R ) + IF ( FST ) + & DEPVJ_FST( J,V,C,R ) = 0.0 ! no stomatal or cuticular uptake for particles + END DO + END IF + END DO + END DO + END DO + + END IF + + IF ( DEPV_DIAG ) THEN + + WRITE_TIME = .FALSE. + WSTEP = WSTEP + TIME2SEC( TSTEP( 2 ) ) + IF ( WSTEP .GE. TIME2SEC( TSTEP( 1 ) ) ) THEN + WDATE = JDATE; WTIME = JTIME + CALL NEXTIME( WDATE, WTIME, TSTEP( 2 ) ) + IF ( .NOT. CURRSTEP( WDATE, WTIME, SDATE, STIME, TSTEP( 1 ), + & CDATE, CTIME ) ) THEN + XMSG = 'Cannot get step date and time' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + WDATE = CDATE; WTIME = CTIME + WSTEP = 0 + WRITE_TIME = .TRUE. + END IF + + IF ( WRITE_TIME ) THEN + + N = 0 + DO V = 1, N_GC_DEPV + N = N + 1 + + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DBUFF( C,R ) = 100.0 * DEPV( N,C,R ) ! cm/sec + END DO + END DO + + IF ( .NOT. WRITE3( CTM_DEPV_DIAG, UNIQUE_GDEPV( NDX ), + & WDATE, WTIME, DBUFF ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + END IF + + END DO + + DO V = 1, N_NR_DEPV + N = N + 1 + + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DBUFF( C,R ) = 100.0 * DEPV( N+N_AE_DEPV,C,R ) ! cm/sec + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_DIAG, UNIQUE_GDEPV( NDX ), + & WDATE, WTIME, DBUFF ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + END IF + + END DO + + DO N = 1, N_UNIQUE_ADEPV + + NDX = AER_DEPV_SUR( N ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DBUFF( C,R ) = 100.0 * ADEPV( NDX,C,R ) ! cm/sec + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_DIAG, UNIQUE_ADEPV( N ), + & WDATE, WTIME, DBUFF ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + END DO + + END IF ! write_time + + END IF ! DEPV_DIAG + + IF ( MOSAIC ) THEN + + WRITE_TIME_MOS = .FALSE. + WSTEP_MOS = WSTEP_MOS + TIME2SEC( TSTEP( 2 ) ) + IF ( WSTEP_MOS .GE. TIME2SEC( TSTEP( 1 ) ) ) THEN + WDATE = JDATE; WTIME = JTIME + CALL NEXTIME( WDATE, WTIME, TSTEP( 2 ) ) + IF ( .NOT. CURRSTEP( WDATE, WTIME, SDATE, STIME, TSTEP( 1 ), + & CDATE, CTIME ) ) THEN + XMSG = 'Cannot get step date and time' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT3 ) + END IF + WDATE = CDATE; WTIME = CTIME + WSTEP_MOS = 0 + WRITE_TIME_MOS = .TRUE. + END IF + + IF ( WRITE_TIME_MOS ) THEN + + WDATE = JDATE + WTIME = TSTEP( 1 ) * ( JTIME / TSTEP( 1 ) ) + CALL NEXTIME( WDATE, WTIME, TSTEP( 1 ) ) + + N = 0 + DO V = 1, N_GC_DEPV + N = N + 1 + + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = 100.0 * DEPVJ( J,N,C,R ) ! cm/sec + END DO + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_MOS, UNIQUE_GDEPV( NDX ), + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_MOS // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + IF ( FST ) THEN + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = 100.0 * DEPVJ_FST( J,N,C,R ) ! cm/sec + END DO + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_FST, UNIQUE_GDEPV( NDX ), + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_FST // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + END IF + END IF + + END DO + + DO V = 1, N_NR_DEPV + N = N + 1 + + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = 100.0 * DEPVJ( J,N+N_AE_DEPV,C,R ) ! cm/sec + END DO + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_MOS, UNIQUE_GDEPV( NDX ), + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_MOS // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + IF ( FST ) THEN + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = 100.0 * DEPVJ_FST( J,N+N_AE_DEPV,C,R ) ! cm/sec + END DO + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_FST, UNIQUE_GDEPV( NDX ), + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_FST // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + END IF + + END IF + + END DO + + DO N = 1, N_UNIQUE_ADEPV + + NDX = AER_DEPV_SUR( N ) + + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = 100.0 * ADEPVJ( J,NDX,C,R ) ! cm/sec + END DO + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_MOS, UNIQUE_ADEPV( N ), + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + IF ( FST ) THEN + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = 0.0 ! no stomatal flux for aerosols + END DO + END DO + END DO + IF ( .NOT. WRITE3( CTM_DEPV_FST, UNIQUE_ADEPV( N ), + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_FST // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + END IF + + END DO + +! write LAI for each LUC to file + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + IF ( LUFRAC( J,C,R ) .GT. 0.0 ) THEN + DBUFF3( C,R,J ) = LAIJ( J,C,R ) + ELSE + DBUFF3( C,R,J ) = 0.0 ! only output values where there is that plant type + END IF + END DO + END DO + END DO + + IF ( .NOT. WRITE3( CTM_DEPV_MOS, 'LAIJ', + & WDATE, WTIME, DBUFF3) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + +! write RA for each LUC to file + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = RAJ( J,C,R ) + END DO + END DO + END DO + + IF ( .NOT. WRITE3( CTM_DEPV_MOS, 'RAJ', + & WDATE, WTIME, DBUFF3) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + +! write USTAR for each LUC to file + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = USTARJ( J,C,R ) + END DO + END DO + END DO + + IF ( .NOT. WRITE3( CTM_DEPV_MOS, 'USTARJ', + & WDATE, WTIME, DBUFF3) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + +! write Z0 for each LUC to file + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + DO J = 1, N_LUFRAC + DBUFF3( C,R,J ) = Z0J( J,C,R ) + END DO + END DO + END DO + + IF ( .NOT. WRITE3( CTM_DEPV_MOS, 'Z0J', + & WDATE, WTIME, DBUFF3 ) ) THEN + XMSG = 'Could not write ' // CTM_DEPV_DIAG // ' file' + CALL M3EXIT ( PNAME, WDATE, WTIME, XMSG, XSTAT1 ) + END IF + + END IF ! write_time + + END IF ! MOSAIC + + END SUBROUTINE GET_DEPV + + END MODULE DEPV_DEFN diff --git a/models/CCTM/depv/blank/LSM_MOD.F b/models/CCTM/depv/blank/LSM_MOD.F new file mode 100755 index 0000000..1856416 --- /dev/null +++ b/models/CCTM/depv/blank/LSM_MOD.F @@ -0,0 +1,897 @@ + +!------------------------------------------------------------------------! +! 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/depv/m3dry/LSM_MOD.F,v 1.5 2012/01/19 14:23:58 yoj Exp $ + +C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module LSM_Mod + +C------------------------------------------------------------------------------ +C Revision History: +C June 16 11 Created by J. Bash +C April 19 12 J. Bash Updated the LU_FAC data arrays to be a function +C of the annual total N deposition following +C Massad et al 2010 doi:10.5194/acp-10-10359-2010 +C The annual 2002 deposition filed from a previous bi- +C directional model run using values ~ 100 was used. +C The model is not very sensitive to this paramater +C and using different annual deposition fileds would +C result in small changes. +C Sept 12 12 D. Schwede Added NLCD40 land use classification. +C Also some changes made to values in tables for NLCD50. +C Maintain compatability with previous versions of MCIP and detect NLCD-MODIS +C as the same as NLCD50 +C Nov 5 12 D. Schwede Modified albedo for NLCD pasture and grass categories so that they are more +C consistent with the MODIS and USGS values +C Apr 4 13 J. Bash Added general water, forest, shrub, grass, snow/ice, +C agricultural land use classification in a land use type +C to simplify how bidirecitonal NH3 code handles different +C land use data sets. +C------------------------------------------------------------------------------ + + Implicit None + + REAL, SAVE :: wwlt (11) + REAL, SAVE :: wsat (11) + REAL, SAVE :: bslp (11) + REAL, SAVE :: wres (11) + REAL, SAVE :: wfc (11) + REAL, SAVE :: rhob (11) + REAL, SAVE, ALLOCATABLE :: lwmask ( :,: ) + REAL, SAVE, ALLOCATABLE :: seaice ( :,: ) + INTEGER, SAVE :: n_lufrac + CHARACTER( 80 ), SAVE :: LAND_SCHEME + CHARACTER( 5 ), SAVE, ALLOCATABLE :: cat_lu( : ) + + INTEGER, PARAMETER :: n_modis = 20 + INTEGER, PARAMETER :: n_nlcd50 = 50 + INTEGER, PARAMETER :: n_nlcd40 = 40 + INTEGER, PARAMETER :: n_usgs = 24 + + TYPE lu_type + CHARACTER( 30 ) :: name + CHARACTER( 16 ) :: lu_cat + END TYPE lu_type + + +C------------------------------------------------------------------------------- +C Soil Characteristics by Type +C +C # SOIL TYPE WSAT WFC WWLT BSLP CGSAT JP AS C2R C1SAT WRES +C _ _________ ____ ___ ____ ____ _____ ___ ___ ___ _____ ____ +C 1 SAND .395 .135 .068 4.05 3.222 4 .387 3.9 .082 .020 +C 2 LOAMY SAND .410 .150 .075 4.38 3.057 4 .404 3.7 .098 .035 +C 3 SANDY LOAM .435 .195 .114 4.90 3.560 4 .219 1.8 .132 .041 +C 4 SILT LOAM .485 .255 .179 5.30 4.418 6 .105 0.8 .153 .015 +C 5 LOAM .451 .240 .155 5.39 4.111 6 .148 0.8 .191 .027 +C 6 SND CLY LM .420 .255 .175 7.12 3.670 6 .135 0.8 .213 .068 +C 7 SLT CLY LM .477 .322 .218 7.75 3.593 8 .127 0.4 .385 .040 +C 8 CLAY LOAM .476 .325 .250 8.52 3.995 10 .084 0.6 .227 .075 +C 9 SANDY CLAY .426 .310 .219 10.40 3.058 8 .139 0.3 .421 .109 +C 10 SILTY CLAY .482 .370 .283 10.40 3.729 10 .075 0.3 .375 .056 +C 11 CLAY .482 .367 .286 11.40 3.600 12 .083 0.3 .342 .090 +C +C------------------------------------------------------------------------------- +!-- WSAT is saturated soil moisture (M^3/M^3) (JN90) + DATA WSAT / 0.395, 0.410, 0.435, 0.485, 0.451, 0.420, 0.477, + & 0.476, 0.426, 0.482, 0.482 / +!-- WFC is soil field capacity (Rawls et al 1982) + DATA WFC / 0.135, 0.150, 0.195, 0.255, 0.240, 0.255, 0.322, + & 0.325, 0.310, 0.370, 0.367 / +!-- WWLT is wilting point (M^3/M^3) (JN90) + DATA WWLT / 0.068, 0.075, 0.114, 0.179, 0.155, 0.175, 0.218, + & 0.250, 0.219, 0.283, 0.286 / +!-- B is slop of the retention curve (NP89) + DATA BSLP / 4.05, 4.38, 4.90, 5.30, 5.39, 7.12, 7.75, + & 8.52, 10.40, 10.40, 11.40 / +!-- WRES is residual soil moisture (Rawls et al 1982) + DATA WRES / 0.020, 0.035, 0.041, 0.015, 0.027, 0.068, 0.040, + & 0.075, 0.109, 0.056, 0.090 / +! -- RHOB is the soil bulk dnesity following Lyons et al 1997 + DATA RHOB / 1.59e6, 1.55e6, 1.53e6, 1.53e6, 1.55e6, 1.62e6, 1.67e6, + & 1.66e6, 1.83e6, 1.78e6, 1.83e6 / + + +!***************************************************************************** +!***************************************************************************** +! MODIS-ONLY (1XX)/MODIS (2XX) LU characterization ... +!------------------------------------------------------------------------------- +!Index Rstmin Zo Mxfr MnFr MxLA MnLA SNUP ALB LUF HGLU Cat. Description +! 1 175. 100. 90. 80. 4.0 3.0 0.08 12. 246.0 40 Evergreen Needleleaf Forest +! 2 120. 90. 95. 85. 5.0 4.0 0.08 12. 247.0 130 Evergreen Broadleaf Forest +! 3 175. 100. 95. 50. 5.0 1.0 0.08 14. 267.0 81 Deciduous Needleleaf Forest +! 4 200. 100. 95. 50. 5.0 1.0 0.08 16. 268.0 81 Deciduous Broadleaf Forest' +! 5 200. 100. 95. 60. 5.0 2.0 0.08 13. 252.0 139 Mixed Forest +! 6 200. 15. 90. 50. 3.0 1.0 0.03 22. 246.0 125 Closed Shrublands +! 7 200. 15. 75. 50. 2.5 1.0 0.035 20. 246.0 125 Open Shrublands +! 8 150. 25. 80. 60. 2.5 1.0 0.03 22. 246.0 125 Woody Savanna +! 9 120. 15. 70. 50 2.0 1.0 0.04 20. 246.0 125 Savanna +!--------------------------------------------------------------------------------- +! 10 100. 7. 85. 60. 2.5 1.0 0.04 19. 247.0 20 Grasslands +! 11 160 20. 75. 45. 3.0 1.0 0.015 14. 260.0 125 Perminent Wetlands +! 12 70. 10. 95. 10. 3.0 0.5 0.04 18. 340.0 81 Croplands +! 13 150. 80. 40. 20. 3.0 1.0 0.04 11. 338.0 190 Urban andBuilt-up' +! 14 100. 30. 95. 40. 3.0 1.0 0.04 18. 298.0 50 Cropland/Natural Vegetation Mosaic +! 15 9999. 1.2 5. 02. 0.1 0.1 0.02 60. 0.0 0 Snow and Ice +! 16 100. 5. 20. 5. 1.0 0.5 0.02 25. 246.0 125 Barren or Sparsely Vegetated +! 17 9999. 0.1 00. 00. 0.0 0.0 0.01 8. 0.0 0 IGBP water +! 18 175. 30. 70. 50. 3.4 2.0 0.80 15. 246.0 62 Wooded Tundra +! 19 120. 15. 40. 20. 2.4 1.0 0.40 15. 246.0 62 Mixed Tundra +! 20 100. 10. 20. 5. 1.4 0.1 0.015 25. 246.0 18 Barren Tundra +!------------------------------------------------------------------------------------ + + TYPE( lu_type ), PARAMETER :: MODIS( n_modis ) = (/ +! ------ Description -------- --LU cat -- + & lu_type('Evergreen Needleleaf Forest ', 'FOREST '), ! 1 + & lu_type('Evergreen Broadleaf Forest ', 'FOREST '), ! 2 + & lu_type('Deciduous Needleleaf Forest ', 'FOREST '), ! 3 + & lu_type('Deciduous Broadleaf Forest ', 'FOREST '), ! 4 + & lu_type('Mixed Forest ', 'FOREST '), ! 5 + & lu_type('Closed Shrublands ', 'SHRUB '), ! 6 + & lu_type('Open Shrublands ', 'SHRUB '), ! 7 + & lu_type('Woody Savanna ', 'FOREST '), ! 8 + & lu_type('Savanna ', 'FOREST '), ! 9 + & lu_type('Grasslands ', 'GRASS '), ! 10 + & lu_type('Perminent Wetlands ', 'WETLAND '), ! 11 + & lu_type('Croplands ', 'AG '), ! 12 + & lu_type('Urban and Built-up ', 'BUILT '), ! 13 + & lu_type('Crop/Natural Mosaic ', 'AGMOS '), ! 14 + & lu_type('Snow and Ice ', 'SNOWICE '), ! 15 + & lu_type('Sparsely Vegetated ', 'BARREN '), ! 16 + & lu_type('IGBP water ', 'WATER '), ! 17 + & lu_type('Wooded Tundra ', 'FOREST '), ! 18 + & lu_type('Mixed Tundra ', 'SHRUB '), ! 19 + & lu_type('Barren Tundra ', 'GRASS ')/) ! 20 +!------------------------------------------------------------------------------------ + + + REAL, DIMENSION(n_modis), TARGET :: RSMIN_MODIS, Z00_MODIS, + & VEG0_MODIS, VEGMN0_MODIS, + & LAI0_MODIS, LAIMN0_MODIS, + & SNUP0_MODIS, ALBF_MODIS, + & LUF_FAC_MODIS, HGLU_FAC_MODIS + + DATA RSMIN_MODIS + & / 175.0, 120.0, 175.0, 200.0, 200.0, + & 200.0, 200.0, 150.0, 120.0, 100.0, + & 160.0, 70.0, 150.0, 100.0, 9999.0, + & 100.0, 9999.0, 175.0, 120.0, 100.0 / + + DATA Z00_MODIS + & / 100.0, 90.0, 100.0, 100.0, 100.0, + & 15.0, 15.0, 25.0, 15.0, 7.0, + & 20.0, 10.0, 80.0, 30.0, 1.2, + & 5.0, 0.1, 30.0, 15.0, 10.0 / + + DATA VEG0_MODIS + & / 90.0, 95.0, 95.0, 95.0, 95.0, + & 90.0, 75.0, 80.0, 70.0, 85.0, + & 75.0, 95.0, 40.0, 95.0, 5.0, + & 20.0, 0.0, 70.0, 40.0, 20.0 / + + DATA VEGMN0_MODIS + & / 80.0, 85.0, 50.0, 50.0, 60.0, + & 50.0, 50.0, 60.0, 50.0, 60.0, + & 45.0, 10.0, 20.0, 40.0, 2.0, + & 5.0, 0.0, 50.0, 20.0, 5.0 / + + DATA LAI0_MODIS + & / 4.0, 5.0, 5.0, 5.0, 5.0, + & 3.0, 2.5, 2.5, 2.0, 2.5, + & 3.0, 3.0, 3.0, 3.0, 0.1, + & 1.0, 0.0, 3.4, 2.4, 1.4 / + + DATA LAIMN0_MODIS + & / 3.0, 4.0, 1.0, 1.0, 2.0, + & 1.0, 1.0, 1.0, 1.0, 1.0, + & 1.0, 0.5, 1.0, 1.0, 0.1, + & 0.5, 0.0, 2.0, 1.0, 0.1 / + + DATA SNUP0_MODIS + & / 0.08, 0.08, 0.08, 0.08, 0.08, + & 0.03, 0.035, 0.03, 0.04, 0.04, + & 0.015, 0.04, 0.04, 0.04, 0.02, + & 0.02, 0.01, 0.80, 0.40, 0.015 / + + DATA ALBF_MODIS + & / 12.0, 12.0, 14.0, 16.0, 13.0, + & 22.0, 20.0, 22.0, 20.0, 19.0, + & 14.0, 18.0, 11.0, 18.0, 60.0, + & 25.0, 8.0, 15.0, 15.0, 25.0 / + + DATA LUF_FAC_MODIS + & / 246.0, 247.0, 267.0, 268.0, 252.0, + & 246.0, 246.0, 246.0, 246.0, 247.0, + & 260.0, 340.0, 338.0, 298.0, 0.0, + & 246.0, 0.0, 246.0, 246.0, 246.0 / + + DATA HGLU_FAC_MODIS + & / 40.0, 130.0, 81.0, 81.0, 139.0, + & 125.0, 125.0, 125.0, 125.0, 20.0, + & 125.0, 80.0, 190.0, 50.0, 0.0, + & 125.0, 0.0, 62.0, 62.0, 18.0 / + +!**************************************************************************************** +!**************************************************************************************** +! 50 CLASS NLCD (US only, cats 1-30)/MODIS (Outside US, cats 31-50) LU characterization +!--------------------------------------------------------------------------------------- +!Index Rstmin Zo Mxfr MnFr MxLA MnLA SNUP ALB LUF HGLU Cat Desc. +! 1 9999. 0.1 00. 00. 0.0 0.0 0.01 8 0.0 0 Open water +! 2 9999. 1.2 5. 02. 0.1 0.1 0.02 60 0.0 0 Perennial Ice/snow +! 3 120. 30. 90. 80. 3.0 1.0 0.04 12 312.0 130 Developed, Open space +! 4 120. 40. 70 60. 3.0 1.0 0.04 11 305.0 150 Developed, Low Intensity +! 5 140. 60. 40. 30. 3.0 1.0 0.04 10 331.0 170 Developed, Medium Intensity +! 6 160. 100. 15. 5. 3.0 1.0 0.04 10 402.0 190 Developed, High Intensity +! 7 100. 5. 20. 5. 1.0 0.5 0.02 20 246.0 125 Barren land +! 8 100. 5. 15. 5. 0.5 0.2 0.02 35 248.0 0 Unconsolidated Shore +! 9 200. 100. 95. 50. 5.0 1.0 0.08 15 274.0 81 Deciduous Forest +! 10 175. 100. 90. 80. 4.0 3.0 0.08 10 246.0 81 Evergreen Forest +!------------------------------------------------------------------------------ +! 11 200. 100. 95. 60. 5.0 2.0 0.08 13 254.0 139 Mixed Forest +! 12 200. 10. 50. 20. 2.0 1.0 0.04 20 246.0 73 Dwarf Scrub +! 13 200. 15. 75. 50. 2.5 1.0 0.04 20 246.0 125 Shrub/Scrub +! 14 100. 7. 85. 60. 2.5 1.0 0.04 19 247.0 20 Grassland/Herbaceous +! 15 100. 7. 80. 20. 2.0 1.0 0.01 23 246.0 125 Sedge/Herbaceous +! 16 100. 5. 80. 20. 1.0 1.0 0.01 20 0.0 18 Lichens +! 17 100. 5. 80. 20. 1.0 1.0 0.01 20 0.0 18 Moss +! 18 100. 5. 50. 20. 1.0 1.0 0.02 15 246.0 62 Tundra +! 19 80. 7. 95. 80. 3.0 1.0 0.04 18 344.0 50 Pasture/Hay' +! 20 70. 10. 95. 10. 3.0 0.5 0.04 18 340.0 80 Cultivated Crops +!------------------------------------------------------------------------------ +! 21 200. 55. 90. 80. 5.0 2.0 0.08 15 271.0 125 Woody Wetland +! 22 200. 80. 90. 80. 5.0 2.0 0.08 15 267.0 125 Palustrine Forested Wetland +! 23 164. 30. 90. 80. 3.0 1.0 0.04 15 254.0 125 Palustrine Scrub/Shrub Wetland +! 24 200. 60. 90. 80. 5.0 2.0 0.08 15 267.0 125 Estuarine Forested Wetland +! 25 164. 30. 90. 80. 3.0 1.0 0.04 15 267.0 125 Estuarine Scrub/Shrub Wetland +! 26 120. 11. 60. 40. 2.0 1.0 0.04 18 248.0 125 Emergent Herbaceous Wetland +! 27 120. 11. 80. 40. 2.0 1.0 0.06 18 269.0 125 Palustrine Emergent Wetland +! 28 120. 11. 80. 40. 2.0 1.0 0.06 18 262.0 125 Estuarine Emergent Wetland +! 29 100. 5. 60. 20. 1.0 0.5 0.02 10 277.0 125 Palustrine Aquatic Bed +! 30 100. 5. 60. 20. 1.0 0.5 0.02 10 247.0 125 Estuarine Aquatic Bed +!------------------------------------------------------------------------------ +! 31 9999. 0.1 00. 00. 0.0 0.0 0.08 8 0.0 0 Open water (mapped to 1) +! 32 175. 100. 90. 80. 4.0 3.0 0.08 12 246.0 40 Evergreen Needleleaf Forest +! 33 120. 90. 95. 85. 5.0 4.0 0.08 12 247.0 130 Evergreen Broadleaf Forest +! 34 175. 100. 95. 50. 5.0 1.0 0.08 14 246.0 81 Deciduous Needleleaf Forest +! 35 200. 100. 95. 50. 5.0 1.0 0.08 16 251.0 81 Deciduous Broadleaf Forest' +! 36 200. 100. 95. 60. 5.0 2.0 0.08 13 246.0 139 Mixed Forest +! 37 200. 15. 90. 50. 3.0 1.0 0.03 22 246.0 125 Closed Shrublands +! 38 200. 15. 75. 50. 2.5 1.0 0.035 20 246.0 125 Open Shrublands +! 39 150. 25. 80. 60. 2.5 1.0 0.03 22 246.0 125 Woody Savanna +! 40 120. 15. 70. 50 2.0 1.0 0.04 20 246.0 125 Savanna +!------------------------------------------------------------------------------ +! 41 100. 7. 85. 60. 2.5 1.0 0.04 19 246.0 20 Grasslands +! 42 160. 20. 75. 45. 3.0 1.0 0.015 14 246.0 125 Perminent Wetlands +! 43 70. 10. 95. 10. 3.0 0.5 0.04 18 323.0 81 Croplands +! 44 150. 80. 40. 20. 3.0 1.0 0.04 11 281.0 190 Urban andBuilt-up' +! 45 100. 30. 95. 40. 3.0 1.0 0.04 18 298.0 50 Cropland/Natural Vegetation Mosaic +! 46 9999. 1.2 5. 02. 0.1 0.1 0.02 60 0.0 0 Snow and Ice +! 47 100. 5. 20. 5. 1.0 0.5 0.02 25 246.0 125 Barren or Sparsely Vegetated +! 48 9999. 0.1 00. 00. 0.0 0.0 0.01 8 0.0 0 IGBP water +! 49 9999. 0.1 00. 00. 0.0 0.0 0.01 8 0.0 0 unclassified +! 50 9999. 0.1 00. 00. 0.0 0.0 0.01 8 0.0 0 fill value (normally ocean water) +!------------------------------------------------------------------------------------ + + TYPE( lu_type ), PARAMETER :: NLCD50( n_nlcd50 ) = (/ +! ------ Description -------- --LU cat -- + & lu_type('Open water ', 'WATER '), ! 1 + & lu_type('Perennial Ice/snow ', 'SNOWICE '), ! 2 + & lu_type('Developed, Open space ', 'BUILT '), ! 3 + & lu_type('Developed, Low Intensity ', 'BUILT '), ! 4 + & lu_type('Developed, Medium Intensity ', 'BUILT '), ! 5 + & lu_type('Developed, High Intensity ', 'BUILT '), ! 6 + & lu_type('Barren land ', 'BARREN '), ! 7 + & lu_type('Unconsolidated Shore ', 'BARREN '), ! 8 + & lu_type('Deciduous Forest ', 'FOREST '), ! 9 + & lu_type('Evergreen Forest ', 'FOREST '), ! 10 + & lu_type('Mixed Forest ', 'FOREST '), ! 11 + & lu_type('Dwarf Scrub ', 'SHRUB '), ! 12 + & lu_type('Shrub/Scrub ', 'SHRUB '), ! 13 + & lu_type('Grassland/Herbaceous ', 'GRASS '), ! 14 + & lu_type('Sedge/Herbaceous ', 'GRASS '), ! 15 + & lu_type('Lichens ', 'BARREN '), ! 16 + & lu_type('Moss ', 'BARREN '), ! 17 + & lu_type('Tundra ', 'BARREN '), ! 18 + & lu_type('Pasture/Hay ', 'AG '), ! 19 + & lu_type('Cultivated Crops ', 'AG '), ! 20 + & lu_type('Woody Wetland ', 'WETLAND '), ! 21 + & lu_type('Palustrine Forested Wetland ', 'WETLAND '), ! 22 + & lu_type('Palustrine Shrub Wetland ', 'WETLAND '), ! 23 + & lu_type('Estuarine Forested Wetland ', 'WETLAND '), ! 24 + & lu_type('Estuarine Shrub Wetland ', 'WETLAND '), ! 25 + & lu_type('Emergent Herbaceous Wetland ', 'WETLAND '), ! 26 + & lu_type('Palustrine Emergent Wetland ', 'WETLAND '), ! 27 + & lu_type('Estuarine Emergent Wetland ', 'WETLAND '), ! 28 + & lu_type('Palustrine Aquatic Bed ', 'WETLAND '), ! 29 + & lu_type('Estuarine Aquatic Bed ', 'WETLAND '), ! 30 + & lu_type('Open water (mapped to 1) ', 'WATER '), ! 31 + & lu_type('Evergreen Needleleaf Forest ', 'FOREST '), ! 32 + & lu_type('Evergreen Broadleaf Forest ', 'FOREST '), ! 33 + & lu_type('Deciduous Needleleaf Forest ', 'FOREST '), ! 34 + & lu_type('Deciduous Broadleaf Forest ', 'FOREST '), ! 35 + & lu_type('Mixed Forest ', 'FOREST '), ! 36 + & lu_type('Closed Shrublands ', 'SHRUB '), ! 37 + & lu_type('Open Shrublands ', 'SHRUB '), ! 38 + & lu_type('Woody Savanna ', 'FOREST '), ! 39 + & lu_type('Savanna ', 'FOREST '), ! 40 + & lu_type('Grasslands ', 'GRASS '), ! 41 + & lu_type('Perminent Wetlands ', 'WETLAND '), ! 42 + & lu_type('Croplands ', 'AG '), ! 43 + & lu_type('Urban and Built-up ', 'BUILT '), ! 44 + & lu_type('Crop/Natural Mosaic ', 'AGMOS '), ! 45 + & lu_type('Snow and Ice ', 'SNOWICE '), ! 46 + & lu_type('Sparsely Vegetated ', 'BARREN '), ! 47 + & lu_type('IGBP water ', 'WATER '), ! 48 + & lu_type('unclassified ', 'SNOWICE '), ! 49 + & lu_type('fill (normally ocean water) ', 'WATER ')/) ! 50 + +!------------------------------------------------------------------------------------ + + REAL, DIMENSION(n_nlcd50), TARGET :: RSMIN_NLCD50, Z00_NLCD50, + & VEG0_NLCD50, VEGMN0_NLCD50, + & LAI0_NLCD50, LAIMN0_NLCD50, + & SNUP0_NLCD50, ALBF_NLCD50, + & LUF_FAC_NLCD50, HGLU_FAC_NLCD50 + + DATA RSMIN_NLCD50 + & / 9999.0, 9999.0, 120.0, 120.0, 140.0, + & 160.0, 100.0, 100.0, 200.0, 175.0, + & 200.0, 200.0, 200.0, 100.0, 100.0, + & 100.0, 100.0, 100.0, 80.0, 70.0, + & 200.0, 200.0, 164.0, 200.0, 164.0, + & 120.0, 120.0, 120.0, 100.0, 100.0, + & 9999.0, 175.0, 120.0, 175.0, 200.0, + & 200.0, 200.0, 200.0, 150.0, 120.0, + & 100.0, 160.0, 70.0, 150.0, 100.0, + & 9999.0, 100.0, 9999.0, 9999.0, 9999.0 / + + DATA Z00_NLCD50 + & / 0.10, 1.20, 30.0, 40.0, 60.0, + & 100.0, 5.0, 5.0, 100.0, 100.0, + & 100.0, 10.0, 15.0, 7.0, 7.0, + & 5.0, 5.0, 5.0, 7.0, 10.0, + & 55.0, 80.0, 30.0, 60.0, 30.0, + & 11.0, 11.0, 11.0, 5.0, 5.0, + & 0.1, 100.0, 90.0, 100.0, 100.0, + & 100.0, 15.0, 15.0, 25.0, 15.0, + & 7.0, 20.0, 10.0, 80.0, 30.0, + & 1.2, 5.0, 0.1, 0.1, 0.1 / + + DATA VEG0_NLCD50 + & / 0.0, 5.0, 90.0, 70.0, 40.0, + & 15.0, 20.0, 15.0, 95.0, 90.0, + & 95.0, 50.0, 75.0, 85.0, 80.0, + & 80.0, 80.0, 50.0, 95.0, 95.0, + & 90.0, 90.0, 90.0, 90.0, 90.0, + & 60.0, 80.0, 80.0, 60.0, 60.0, + & 0.0, 90.0, 95.0, 95.0, 95.0, + & 95.0, 90.0, 75.0, 80.0, 70.0, + & 85.0, 75.0, 95.0, 40.0, 95.0, + & 5.0, 20.0, 0.0, 0.0, 0.0 / + + DATA VEGMN0_NLCD50 + & / 0.0, 2.0, 80.0, 60.0, 30.0, + & 5.0, 5.0, 5.0, 50.0, 80.0, + & 60.0, 20.0, 50.0, 60.0, 20.0, + & 20.0, 20.0, 20.0, 80.0, 10.0, + & 80.0, 80.0, 80.0, 80.0, 80.0, + & 40.0, 40.0, 40.0, 20.0, 20.0, + & 0.0, 80.0, 85.0, 50.0, 50.0, + & 60.0, 50.0, 50.0, 60.0, 50.0, + & 60.0, 45.0, 10.0, 20.0, 40.0, + & 2.0, 5.0, 0.0, 0.0, 0.0 / + + DATA LAI0_NLCD50 + & / 0.0, 0.1, 3.0, 3.0, 3.0, + & 3.0, 1.0, 0.5, 5.0, 4.0, + & 5.0, 2.0, 2.5, 2.5, 2.0, + & 1.0, 1.0, 1.0, 3.0, 3.0, + & 5.0, 5.0, 3.0, 5.0, 3.0, + & 2.0, 2.0, 2.0, 1.0, 1.0, + & 0.0, 4.0, 5.0, 5.0, 5.0, + & 5.0, 3.0, 2.5, 2.5, 2.0, + & 2.5, 3.0, 3.0, 3.0, 3.0, + & 0.1, 1.0, 0.0, 0.0, 0.0 / + + DATA LAIMN0_NLCD50 + & / 0.0, 0.1, 1.0, 1.0, 1.0, + & 1.0, 0.5, 0.2, 1.0, 3.0, + & 2.0, 1.0, 1.0, 1.0, 1.0, + & 1.0, 1.0, 1.0, 1.0, 0.5, + & 2.0, 2.0, 1.0, 2.0, 1.0, + & 1.0, 1.0, 1.0, 0.5, 0.5, + & 0.0, 3.0, 4.0, 1.0, 1.0, + & 2.0, 1.0, 1.0, 1.0, 1.0, + & 1.0, 1.0, 0.5, 1.0, 1.0, + & 0.1, 0.5, 0.0, 0.0, 0.0 / + + DATA SNUP0_NLCD50 + & / 0.01, 0.02, 0.04, 0.04, 0.04, + & 0.04, 0.02, 0.02, 0.08, 0.08, + & 0.08, 0.04, 0.04, 0.04, 0.01, + & 0.01, 0.01, 0.02, 0.04, 0.04, + & 0.08, 0.08, 0.04, 0.08, 0.04, + & 0.04, 0.06, 0.06, 0.02, 0.02, + & 0.08, 0.08, 0.08, 0.08, 0.08, + & 0.08, 0.03, 0.035, 0.03, 0.04, + & 0.04, 0.015, 0.04, 0.04, 0.04, + & 0.02, 0.02, 0.01, 0.01, 0.01 / + + DATA ALBF_NLCD50 + & / 8.0, 60.0, 12.0, 11.0, 10.0, + & 10.0, 20.0, 35.0, 15.0, 10.0, + & 13.0, 20.0, 20.0, 19.0, 23.0, + & 20.0, 20.0, 15.0, 18.0, 18.0, + & 15.0, 15.0, 15.0, 15.0, 15.0, + & 18.0, 18.0, 18.0, 10.0, 10.0, + & 8.0, 12.0, 12.0, 14.0, 16.0, + & 13.0, 22.0, 20.0, 22.0, 20.0, + & 19.0, 14.0, 18.0, 11.0, 18.0, + & 60.0, 25.0, 8.0, 8.0, 8.0 / + + DATA LUF_FAC_NLCD50 + & / 0.0, 0.0, 312.0, 305.0, 331.0, + & 402.0, 246.0, 248.0, 274.0, 246.0, + & 254.0, 246.0, 246.0, 247.0, 246.0, + & 0.0, 0.0, 246.0, 344.0, 340.0, + & 271.0, 267.0, 254.0, 267.0, 267.0, + & 248.0, 269.0, 262.0, 277.0, 247.0, + & 0.0, 246.0, 247.0, 246.0, 251.0, + & 246.0, 246.0, 246.0, 246.0, 246.0, + & 246.0, 246.0, 323.0, 281.0, 298.0, + & 0.0, 246.0, 0.0, 0.0, 0.0 / + + DATA HGLU_FAC_NLCD50 + & / 0.0, 0.0, 130.0, 150.0, 170.0, + & 190.0, 125.0, 0.0, 81.0, 81.0, + & 139.0, 73.0, 125.0, 20.0, 125.0, + & 18.0, 18.0, 62.0, 50.0, 80.0, + & 125.0, 125.0, 125.0, 125.0, 125.0, + & 125.0, 125.0, 125.0, 125.0, 125.0, + & 0.0, 40.0, 130.0, 81.0, 81.0, + & 139.0, 125.0, 125.0, 125.0, 125.0, + & 20.0, 125.0, 81.0, 190.0, 50.0, + & 0.0, 125.0, 0.0, 0.0, 0.0 / + + +!**************************************************************************************** +!**************************************************************************************** +! 40 CLASS MODIS (Outside US, cats 1-20)/NLCD (US only, cats 21-40) LU characterization +!------------------------------------------------------------------------------- +!Index Rstmin Zo Mxfr MnFr MxLA MnLA SNUP ALB LUF HGLU Cat Desc. +! 1 175. 100. 90. 80. 4.0 3.0 0.08 12. 246.0 40 Evergreen Needleleaf Forest +! 2 120. 90. 95. 85. 5.0 4.0 0.08 12. 247.0 130 Evergreen Broadleaf Forest +! 3 175. 100. 95. 50. 5.0 1.0 0.08 14. 246.0 81 Deciduous Needleleaf Forest +! 4 200. 100. 95. 50. 5.0 1.0 0.08 16. 251.0 81 Deciduous Broadleaf Forest' +! 5 200. 100. 95. 60. 5.0 2.0 0.08 13. 246.0 139 Mixed Forest +! 6 200. 15. 90. 50. 3.0 1.0 0.03 22. 246.0 125 Closed Shrublands +! 7 200. 15. 75. 50. 2.5 1.0 0.035 20. 246.0 125 Open Shrublands +! 8 150. 25. 80. 60. 2.5 1.0 0.03 22. 246.0 125 Woody Savanna +! 9 120. 15. 70. 50 2.0 1.0 0.04 20. 246.0 125 Savanna +!--------------------------------------------------- -------------------------- +! 10 100. 7. 85. 60. 2.5 1.0 0.04 19. 246.0 20 Grasslands +! 11 160 20. 75. 45. 3.0 1.0 0.015 14. 246.0 125 Perminent Wetlands +! 12 70. 10. 95. 10. 3.0 0.5 0.04 18. 323.0 81 Croplands +! 13 150. 80. 40. 20. 3.0 1.0 0.04 11. 281.0 190 Urban andBuilt-up' +! 14 100. 30. 95. 40. 3.0 1.0 0.04 18. 298.0 50 Cropland/Natural Vegetation Mosaic +! 15 9999. 1.2 5. 02. 0.1 0.1 0.02 60. 0.0 0 Snow and Ice +! 16 100. 5. 20. 5. 1.0 0.5 0.02 25. 246.0 125 Barren or Sparsely Vegetated +! 17 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 0.0 0 IGBP water +! 18 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 0.0 0 unclassified +! 19 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 0.0 0 fill value (normally ocean water) +! 20 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 0.0 0 unclassified +! 21 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 0.0 0 Open water +! 22 9999. 1.2 5. 02. 0.1 0.1 0.02 60. 0.0 0 Perennial Ice/snow +! 23 120. 30. 90. 80. 3.0 1.0 0.04 12. 312.0 130 Developed, Open space +! 24 120. 40. 70 60. 3.0 1.0 0.04 11. 305.0 150 Developed, Low Intensity +! 25 140. 60. 40. 30. 3.0 1.0 0.04 10. 331.0 170 Developed, Medium Intensity +! 26 160. 100. 15. 5. 3.0 1.0 0.04 10. 402.0 190 Developed, High Intensity +! 27 100. 5. 20. 5. 1.0 0.5 0.02 20. 246.0 125 Barren land +! 28 200. 100. 95. 50. 5.0 1.0 0.08 15. 274.0 81 Deciduous Forest +! 29 175. 100. 90. 80. 4.0 3.0 0.08 12. 246.0 81 Evergreen Forest +!--------------------------------------------------- -------------------------- +! 30 200. 100. 95. 60. 5.0 2.0 0.08 13. 254.0 139 Mixed Forest +! 31 200. 10. 50. 20. 2.0 1.0 0.04 20. 246.0 73 Dwarf Scrub +! 32 200. 15. 75. 50. 2.5 1.0 0.04 20. 246.0 125 Shrub/Scrub +! 33 100. 7. 85. 60. 2.5 1.0 0.04 19. 247.0 20 Grassland/Herbaceous +! 34 100. 7. 80. 20. 2.0 1.0 0.01 23. 246.0 125 Sedge/Herbaceous +! 35 100. 5. 80. 20. 1.0 1.0 0.01 20. 0.0 18 Lichens +! 36 100. 5. 80. 20. 1.0 1.0 0.01 20. 0.0 18 Moss +! 37 80. 7. 95. 80. 3.0 1.0 0.04 18. 344.0 50 Pasture/Hay' +! 38 70. 10. 95. 10. 3.0 0.5 0.04 18. 340.0 80 Cultivated Crops +!--------------------------------------------------- -------------------------- +! 39 200. 55. 90. 80. 5.0 2.0 0.08 15. 271.0 125 Woody Wetland +! 40 120. 11. 60. 40. 2.0 1.0 0.04 18. 248.0 125 Emergent Herbaceous Wetland +!------------------------------------------------------------------------------------ + + TYPE( lu_type ), PARAMETER :: NLCD40( n_nlcd40 ) = (/ +! ------ Description -------- --LU cat -- + & lu_type('Evergreen Needleleaf Forest ', 'FOREST '), ! 1 + & lu_type('Evergreen Broadleaf Forest ', 'FOREST '), ! 2 + & lu_type('Deciduous Needleleaf Forest ', 'FOREST '), ! 3 + & lu_type('Deciduous Broadleaf Forest ', 'FOREST '), ! 4 + & lu_type('Mixed Forest ', 'FOREST '), ! 5 + & lu_type('Closed Shrublands ', 'SHRUB '), ! 6 + & lu_type('Open Shrublands ', 'SHRUB '), ! 7 + & lu_type('Woody Savanna ', 'FOREST '), ! 8 + & lu_type('Savanna ', 'FOREST '), ! 9 + & lu_type('Grasslands ', 'GRASS '), ! 10 + & lu_type('Perminent Wetlands ', 'WETLAND '), ! 11 + & lu_type('Croplands ', 'AG '), ! 12 + & lu_type('Urban and Built-up ', 'BUILT '), ! 13 + & lu_type('Crop/Natural Mosaic ', 'AGMOS '), ! 14 + & lu_type('Snow and Ice ', 'SNOWICE '), ! 15 + & lu_type('Sparsely Vegetated ', 'BARREN '), ! 16 + & lu_type('IGBP water ', 'WATER '), ! 17 + & lu_type('unclassified MODIS ', 'SNOWICE '), ! 18 + & lu_type('fill (normally ocean water) ', 'WATER '), ! 19 + & lu_type('unclassified NLCD ', 'SNOWICE '), ! 20 + & lu_type('Open water ', 'WATER '), ! 21 + & lu_type('Perennial Ice/snow ', 'SNOWICE '), ! 22 + & lu_type('Developed, Open space ', 'BUILT '), ! 23 + & lu_type('Developed, Low Intensity ', 'BUILT '), ! 24 + & lu_type('Developed, Medium Intensity ', 'BUILT '), ! 25 + & lu_type('Developed, High Intensity ', 'BUILT '), ! 26 + & lu_type('Barren land ', 'BARREN '), ! 27 + & lu_type('Deciduous Forest ', 'FOREST '), ! 28 + & lu_type('Evergreen Forest ', 'FOREST '), ! 29 + & lu_type('Mixed Forest ', 'FOREST '), ! 30 + & lu_type('Dwarf Scrub ', 'SHRUB '), ! 31 + & lu_type('Shrub/Scrub ', 'SHRUB '), ! 32 + & lu_type('Grassland/Herbaceous ', 'GRASS '), ! 33 + & lu_type('Sedge/Herbaceous ', 'GRASS '), ! 34 + & lu_type('Lichens ', 'BARREN '), ! 35 + & lu_type('Moss ', 'BARREN '), ! 36 + & lu_type('Pasture/Hay ', 'AG '), ! 37 + & lu_type('Cultivated Crops ', 'AG '), ! 38 + & lu_type('Woody Wetland ', 'WETLAND '), ! 39 + & lu_type('Emergent Herbaceous Wetland ', 'WETLAND ')/) ! 40 +!------------------------------------------------------------------------------------ +!------------------------------------------------------------------------------------ + + REAL, DIMENSION(n_nlcd40), TARGET :: RSMIN_NLCD40, Z00_NLCD40, + & VEG0_NLCD40, VEGMN0_NLCD40, + & LAI0_NLCD40, LAIMN0_NLCD40, + & SNUP0_NLCD40, ALBF_NLCD40, + & LUF_FAC_NLCD40, HGLU_FAC_NLCD40 + + DATA RSMIN_NLCD40 + & / 175.0, 120.0, 175.0, 200.0, 200.0, + & 200.0, 200.0, 150.0, 120.0, 100.0, + & 160.0, 70.0, 150.0, 100.0, 9999.0, + & 100.0, 9999.0, 9999.0, 9999.0, 9999.0, + & 9999.0, 9999.0, 120.0, 120.0, 140.0, + & 160.0, 100.0, 200.0, 175.0, 200.0, + & 200.0, 200.0, 100.0, 100.0, 100.0, + & 100.0, 80.0, 70.0, 200.0, 120.0 / + + DATA Z00_NLCD40 + & / 100.0, 90.0, 100.0, 100.0, 100.0, + & 15.0, 15.0, 25.0, 15.0, 7.0, + & 20.0, 10.0, 80.0, 30.0, 1.2, + & 5.0, 0.1, 0.1, 0.1, 0.1, + & 0.10, 1.20, 30.0, 40.0, 60.0, + & 100.0, 5.0, 100.0, 100.0, 100.0, + & 10.0, 15.0, 7.0, 7.0, 5.0, + & 5.0, 7.0, 10.0, 55.0, 11.0 / + + DATA VEG0_NLCD40 + & / 90.0, 95.0, 95.0, 95.0, 95.0, + & 90.0, 75.0, 80.0, 70.0, 85.0, + & 75.0, 95.0, 40.0, 95.0, 5.0, + & 20.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 5.0, 90.0, 70.0, 40.0, + & 15.0, 20.0, 95.0, 90.0, 95.0, + & 50.0, 75.0, 85.0, 80.0, 80.0, + & 80.0, 95.0, 95.0, 90.0, 60.0 / + + DATA VEGMN0_NLCD40 + & / 80.0, 85.0, 50.0, 50.0, 60.0, + & 50.0, 50.0, 60.0, 50.0, 60.0, + & 45.0, 10.0, 20.0, 40.0, 2.0, + & 5.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 2.0, 80.0, 60.0, 30.0, + & 05.0, 05.0, 50.0, 80.0, 60.0, + & 20.0, 50.0, 60.0, 20.0, 20.0, + & 20.0, 80.0, 10.0, 80.0, 40.0 / + + DATA LAI0_NLCD40 + & / 4.0, 5.0, 5.0, 5.0, 5.0, + & 3.0, 2.5, 2.5, 2.0, 2.5, + & 3.0, 3.0, 3.0, 3.0, 0.1, + & 1.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.1, 3.0, 3.0, 3.0, + & 3.0, 1.0, 5.0, 4.0, 5.0, + & 2.0, 2.5, 2.5, 2.0, 1.0, + & 1.0, 3.0, 3.0, 5.0, 2.0 / + + DATA LAIMN0_NLCD40 + & / 3.0, 4.0, 1.0, 1.0, 2.0, + & 1.0, 1.0, 1.0, 1.0, 1.0, + & 1.0, 0.5, 1.0, 1.0, 0.1, + & 0.5, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.1, 1.0, 1.0, 1.0, + & 1.0, 0.5, 1.0, 3.0, 2.0, + & 1.0, 1.0, 1.0, 1.0, 1.0, + & 1.0, 1.0, 0.5, 2.0, 1.0 / + + DATA SNUP0_NLCD40 + & / 0.08, 0.08, 0.08, 0.08, 0.08, + & 0.03, 0.035, 0.03, 0.04, 0.04, + & 0.015, 0.04, 0.04, 0.04, 0.02, + & 0.02, 0.01, 0.01, 0.01, 0.01, + & 0.01, 0.02, 0.04, 0.04, 0.04, + & 0.04, 0.02, 0.08, 0.08, 0.08, + & 0.04, 0.04, 0.04, 0.01, 0.01, + & 0.01, 0.04, 0.04, 0.08, 0.04 / + + DATA ALBF_NLCD40 + & / 12.0, 12.0, 14.0, 16.0, 13.0, + & 22.0, 20.0, 22.0, 20.0, 19.0, + & 14.0, 18.0, 11.0, 18.0, 60.0, + & 25.0, 8.0, 8.0, 8.0, 8.0, + & 8.0, 60.0, 12.0, 11.0, 10.0, + & 10.0, 20.0, 15.0, 12.0, 13.0, + & 20.0, 20.0, 19.0, 23.0, 20.0, + & 20.0, 18.0, 18.0, 15.0, 18.0 / + + DATA LUF_FAC_NLCD40 + & / 246.0, 247.0, 246.0, 251.0, 246.0, + & 246.0, 246.0, 246.0, 246.0, 246.0, + & 246.0, 323.0, 281.0, 298.0, 0.0, + & 246.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 312.0, 305.0, 331.0, + & 402.0, 246.0, 274.0, 246.0, 254.0, + & 246.0, 246.0, 247.0, 246.0, 0.0, + & 0.0, 344.0, 340.0, 271.0, 248.0 / + + DATA HGLU_FAC_NLCD40 + & / 40.0, 130.0, 81.0, 81.0, 139.0, + & 125.0, 125.0, 125.0, 125.0, 20.0, + & 125.0, 81.0, 190.0, 50.0, 0.0, + & 125.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 130.0, 150.0, 170.0, + & 190.0, 125.0, 81.0, 81.0, 139.0, + & 73.0, 125.0, 20.0, 125.0, 18.0, + & 18.0, 50.0, 80.0, 125.0, 125.0 / + + +!***************************************************************************** +!***************************************************************************** +! USGS LU characterization -- note below may not match those for the same category in a diff +! classification system. This was done to maintain compatibility with MM5. +!----------------------------------------------------------------------------- +! Name Rstmin Zo Mxfr MnFr MxLA MnLA SNUP ALB LUF HGLU Cat Desc. +! 1 Urban 150. 50. 40. 20. 2.0 0.5 0.04 15.0 338.0 190.0 Urban or Built-up Land +! 2 DrCrp 70. 10. 95. 15. 3.0 0.5 0.04 17.0 340.0 80.0 Dryland Cropland and Pasture +! 3 IrCrp 60. 10. 95. 10. 3.0 0.5 0.04 18.0 340.0 32.0 Irrigated Cropland and Pasture +! 4 MixCp 70. 10. 95. 15. 3.0 0.5 0.04 18.0 340.0 56.0 Mixed Dry/Irr Crop and Past +! 5 CrGrM 80. 10. 95. 35. 2.5 1.0 0.04 18.0 298.0 50.0 Grassland/Cropland Mosaic +! 6 CrWdM 180. 40. 95. 40. 4.0 1.5 0.04 16.0 298.0 26.0 Woodland/Cropland Mosaic +! 7 GrsLd 100. 7. 95. 70. 2.5 1.0 0.04 19.0 247.0 20.0 Grassland +! 8 ShrLd 200. 20. 70. 50. 3.0 1.0 0.03 22.0 246.0 125.0 Shrubland +! 9 ShrGr 150. 20. 85. 60. 3.0 1.0 0.035 20.0 246.0 73.0 Mixed Shrubland/Grassland +! 10 Savan 120. 20. 80. 60. 2.0 1.0 0.04 20.0 246.0 51.0 Savanna +! 11 DBFst 200. 50. 95. 50. 5.0 1.0 0.08 16.0 268.0 81.0 Broadleaf Deciduous Forest +! 12 DNFst 175. 50. 95. 50. 5.0 1.0 0.08 14.0 267.0 81.0 Deciduous Coniferous Forest +! 13 EBFst 120. 40. 95. 85. 5.0 4.0 0.08 12.0 247.0 130.0 Evergreen Broadleaf Forest (Palm?) +! 14 ENFst 175. 50. 90. 80. 4.0 3.0 0.08 12.0 246.0 40.0 Evergreen Coniferous Forest +! 15 MxFst 200. 50. 95. 60. 5.0 2.0 0.08 13.0 252.0 139.0 Mixed forest +! 16 Water 9999. 0.1 00. 00. 0.0 0.0 0.01 8.0 0.0 0.0 Water +! 17 HWtld 164. 15. 60. 40. 2.0 1.0 0.01 14.0 248.0 125.0 Herbaceous Wetland (none in east) +! 18 WWtld 200. 45. 90. 80. 5.0 3.0 0.01 14.0 260.0 125.0 Forested Wetlands (e.g. Everglades) +! 19 BarSp 100. 5. 10. 05. 0.5 0.2 0.02 25.0 246.0 26.0 Barren or Sparsely Vegetated +! 20 HrTun 150. 10. 20. 10. 1.0 0.5 0.02 15.0 246.0 62.0 Herbaceous Tundra +! 21 WdTun 200. 10. 30. 10. 1.0 0.5 0.025 15.0 246.0 62.0 Shrub and Brush Tundra +! 22 MxTun 150. 5. 20. 05. 1.0 0.5 0.025 15.0 246.0 62.0 Mixed Tundra +! 23 BGTun 100. 5. 5. 02. 0.1 0.1 0.025 25.0 246.0 18.0 Bare Ground Tundra +! 24 SnwIc 300. 5. 5. 02. 0.1 0.1 0.02 55.0 0.0 0.0 Perennial Snowfields or Glaciers +!----------------------------------------------------------------------------- + + TYPE( lu_type ), PARAMETER :: USGS24( n_usgs ) = (/ +! ------ Description -------- --LU cat -- + & lu_type('Urban or Built-up Land ', 'BUILT '), ! 1 + & lu_type('Dryland Crop and Pasture ', 'AG '), ! 2 + & lu_type('Irr. Cropland and Pasture ', 'AG '), ! 3 + & lu_type('Mixed Dry/Irr Crop and Past ', 'AG '), ! 4 + & lu_type('Grassland/Cropland Mosaic ', 'AGMOS '), ! 5 + & lu_type('Woodland/Cropland Mosaic ', 'AGMOS '), ! 6 + & lu_type('Grassland ', 'GRASS '), ! 7 + & lu_type('Shrubland ', 'SHRUB '), ! 8 + & lu_type('Mixed Shrubland/Grassland ', 'SHRUB '), ! 9 + & lu_type('Savanna ', 'SHRUB '), ! 10 + & lu_type('Broadleaf Deciduous Forest ', 'FOREST '), ! 11 + & lu_type('Deciduous Coniferous Forest ', 'FOREST '), ! 12 + & lu_type('Evergreen Broadleaf Forest ', 'FOREST '), ! 13 + & lu_type('Evergreen Coniferous Forest ', 'FOREST '), ! 14 + & lu_type('Mixed forest ', 'FOREST '), ! 15 + & lu_type('Water ', 'WATER '), ! 16 + & lu_type('Herbaceous Wetland ', 'WETLAND '), ! 17 + & lu_type('Forested Wetlands ', 'WETLAND '), ! 18 + & lu_type('Barren or Sparsely Vegetated', 'BARREN '), ! 19 + & lu_type('Herbaceous Tundra ', 'SHRUB '), ! 20 + & lu_type('Shrub and Brush Tundra ', 'SHRUB '), ! 21 + & lu_type('Mixed Tundra ', 'SHRUB '), ! 22 + & lu_type('Bare Ground Tundra ', 'BARREN '), ! 23 + & lu_type('Snowfields or Glaciers ', 'SNOWICE ')/) ! 24 +!----------------------------------------------------------------------------- + + REAL, DIMENSION(n_usgs), TARGET :: RSMIN_USGS, Z00_USGS, + & VEG0_USGS, VEGMN0_USGS, + & LAI0_USGS, LAIMN0_USGS, + & SNUP0_USGS, ALBF_USGS, + & LUF_FAC_USGS, HGLU_FAC_USGS + + DATA RSMIN_USGS + & / 150.0, 70.0, 60.0, 70.0, 80.0, + & 180.0, 100.0, 200.0, 150.0, 120.0, + & 200.0, 175.0, 120.0, 175.0, 200.0, + & 9999.0, 164.0, 200.0, 100.0, 150.0, + & 200.0, 150.0, 100.0, 300.0 / + + DATA Z00_USGS + & / 50.0, 10.0, 10.0, 10.0, 10.0, + & 40.0, 7.0, 20.0, 20.0, 20.0, + & 50.0, 50.0, 40.0, 50.0, 50.0, + & 0.1, 15.0, 45.0, 5.0, 10.0, + & 10.0, 5.0, 5.0, 5.0 / + + DATA VEG0_USGS + & / 40.0, 95.0, 95.0, 95.0, 95.0, + & 95.0, 95.0, 70.0, 85.0, 80.0, + & 95.0, 95.0, 95.0, 90.0, 95.0, + & 0.00, 60.0, 90.0, 10.0, 20.0, + & 30.0, 20.0, 5.0, 5.0 / + + DATA VEGMN0_USGS + & / 20.0, 15.0, 10.0, 15.0, 35.0, + & 40.0, 70.0, 50.0, 60.0, 60.0, + & 50.0, 50.0, 85.0, 80.0, 60.0, + & 0.0, 40.0, 80.0, 5.0, 10.0, + & 10.0, 5.0, 2.0, 2.0 / + + DATA LAI0_USGS + & / 2.0, 3.0, 3.0, 3.0, 2.5, + & 4.0, 2.5, 3.0, 3.0, 2.0, + & 5.0, 5.0, 5.0, 4.0, 5.0, + & 0.0, 2.0, 5.0, 0.50, 1.0, + & 1.0, 1.0, 0.1, 0.1 / + + DATA LAIMN0_USGS + & / 0.50, 0.50, 0.50, 0.50, 1.0, + & 1.5, 1.0, 1.0, 1.0, 1.0, + & 1.0, 1.0, 4.0, 3.0, 2.0, + & 0.0, 1.0, 3.0, 0.20, 0.50, + & 0.50, 0.50, 0.10, 0.10 / + + DATA SNUP0_USGS + & / 0.04, 0.04, 0.04, 0.04, 0.04, + & 0.04, 0.04, 0.03, 0.035, 0.04, + & 0.08, 0.08, 0.08, 0.08, 0.08, + & 0.01, 0.01, 0.01, 0.02, 0.02, + & 0.025, 0.025, 0.025, 0.02 / + + DATA ALBF_USGS + & / 15.0, 17.0, 18.0, 18.0, 18.0, + & 16.0, 19.0, 22.0, 20.0, 20.0, + & 16.0, 14.0, 12.0, 12.0, 13.0, + & 8.0, 14.0, 14.0, 25.0, 15.0, + & 15.0, 15.0, 25.0, 55.0 / + + DATA LUF_FAC_USGS + & / 338.0, 340.0, 340.0, 340.0, 298.0, + & 298.0, 247.0, 246.0, 246.0, 246.0, + & 268.0, 267.0, 247.0, 246.0, 252.0, + & 0.0, 248.0, 260.0, 246.0, 246.0, + & 246.0, 246.0, 246.0, 0.0 / + + DATA HGLU_FAC_USGS + & / 190.0, 80.0, 32.0, 56.0, 50.0, + & 26.0, 20.0, 125.0, 73.0, 51.0, + & 81.0, 81.0, 130.0, 40.0, 139.0, + & 0.0, 125.0, 125.0, 26.0, 62.0, + & 62.0, 62.0, 18.0, 0.0 / + CONTAINS + SUBROUTINE INIT_LSM( JDate, JTime ) + + USE HGRD_DEFN + USE UTILIO_DEFN +#ifdef twoway + USE twoway_data_module, ONLY : num_land_cat +#endif + + IMPLICIT NONE + + INCLUDE SUBST_FILES_ID ! file name parameters + + INTEGER, INTENT( In ) :: jdate + INTEGER, INTENT( In ) :: jtime + CHARACTER( 240 ) :: XMSG = ' ' + CHARACTER( 16 ), SAVE :: PNAME = 'Init_LSM' + INTEGER :: GXOFF, GYOFF ! global origin offset from file + INTEGER :: STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 + INTEGER l + + LAND_SCHEME = 'UNKNOWN' + CALL SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, + & STRTCOLGC2, ENDCOLGC2, STRTROWGC2, ENDROWGC2 ) + + IF ( .NOT. DESC3( GRID_CRO_2D ) ) THEN + XMSG = 'COULD NOT GET GRID_CRO_2D FILE DESCRIPTION ' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + END IF + +#ifdef twoway + IF ( NUM_LAND_CAT .EQ. 24 ) THEN + LAND_SCHEME = 'USGS24' + ELSE IF ( NUM_LAND_CAT .EQ. 20 ) THEN + LAND_SCHEME = 'MODIS' + ELSE IF ( NUM_LAND_CAT .EQ. 50 ) THEN + LAND_SCHEME = 'NLCD50' + ELSE IF ( NUM_LAND_CAT .EQ. 40 ) THEN + LAND_SCHEME = 'NLCD40' + END IF +#else + DO l = 1, NVARS3D ! determine land character + IF ( VNAME3D( l ) .EQ. 'DLUSE' ) THEN + IF ( INDEX( VDESC3D( l ), 'USGS24' ) .NE. 0 ) LAND_SCHEME = 'USGS24' + IF ( INDEX( VDESC3D( l ), 'MODIS' ) .NE. 0 ) LAND_SCHEME = 'MODIS' + IF ( INDEX( VDESC3D( l ), 'NLCD-MODIS' ) .NE. 0 ) LAND_SCHEME = 'NLCD50' + IF ( INDEX( VDESC3D( l ), 'NLCD50' ) .NE. 0 ) LAND_SCHEME = 'NLCD50' + IF ( INDEX( VDESC3D( l ), 'NLCD40' ) .NE. 0 ) LAND_SCHEME = 'NLCD40' + END IF + END DO +#endif +! Write( *,* ) 'Land use scheme is ', TRIM(LAND_SCHEME) + + SELECT CASE( LAND_SCHEME ) + CASE( 'USGS24' ) + n_lufrac = n_usgs + If ( .Not. Allocated ( cat_lu ) ) Then + Allocate ( cat_lu ( n_lufrac ) ) + End If + cat_lu = USGS24%lu_cat + CASE( 'MODIS' ) + n_lufrac = n_modis + If ( .Not. Allocated ( cat_lu ) ) Then + Allocate ( cat_lu ( n_lufrac ) ) + End If + cat_lu = MODIS%lu_cat + CASE( 'NLCD50' ) + n_lufrac = n_nlcd50 + If ( .Not. Allocated ( cat_lu ) ) Then + Allocate ( cat_lu ( n_lufrac ) ) + End If + cat_lu = NLCD50%lu_cat + CASE( 'NLCD40' ) + n_lufrac = n_nlcd40 + If ( .Not. Allocated ( cat_lu ) ) Then + Allocate ( cat_lu ( n_lufrac ) ) + End If + cat_lu = NLCD40%lu_cat + CASE DEFAULT + xmsg = 'Land use scheme not supported' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + END SELECT + + END SUBROUTINE Init_LSM + + END MODULE LSM_Mod diff --git a/models/CCTM/depv/blank/MOSAIC_MOD.F b/models/CCTM/depv/blank/MOSAIC_MOD.F new file mode 100755 index 0000000..8a14fe5 --- /dev/null +++ b/models/CCTM/depv/blank/MOSAIC_MOD.F @@ -0,0 +1,743 @@ + +!------------------------------------------------------------------------! +! 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/depv/m3dry/MOSAIC_MOD.F,v 1.6 2012/03/28 16:11:09 yoj Exp $ + +c::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + Module MOSAIC_MOD + +C Contains the shared variables and subrountes needed estimated the resistances +C from natural and agricultrual lands for NH3 bidirectional flux + +C Revision History: J. Bash June 16 2011: Created +C J. Young Oct 31 2011: changed lai0, laimn0, rsmin, veg0, vegmn0, +C z00, & luf_fac to pointers to save memory +C D. Schwede Mar 12 2012: fixed errors in crop lai +C D. Schwede Sept 07 2012: updated code for NLCD40 land use classification + + Implicit None + +C shared variables +! Integer, Save :: n_lufrac + Real, Save, Allocatable :: hcanj (:) ! Canopy height for LU j + Real, Save, Allocatable :: lufraccr(:) ! Column Row LU fraction + Real, Save, Allocatable :: laijcr (:) ! Column Row LAI for LU j + Real, Save, Allocatable :: vegjcr (:) ! + Real, Save, Allocatable :: z0jcr (:) ! Column Row z0 for LU j + Real, Save, Allocatable :: rbcj (:) ! Colum Row boundary layer resist for LU j + + Real, Save, Pointer :: lai0_p (:) ! Met model LAI for LU j (MOSAIC) + Real, Save, Pointer :: laimn0_p (:) ! Met model min LAI for LU j (MOSAIC) + Real, Save, Pointer :: rsmin_p (:) ! Min Rs for LU j (m3dry & MOSAIC) + Real, Save, Pointer :: veg0_p (:) ! (MOSAIC) + Real, Save, Pointer :: vegmn0_p (:) ! (MOSAIC) + Real, Save, Pointer :: z00_p (:) ! Met model z0 for LU j (MOSAIC) + Real, Save, Pointer :: luf_fac_p (:) ! Leaf emission pot. (NH3 bidi & MOSAIC) + + Real, Save, Allocatable :: rgndcj ( :,:,: ) ! Rgnd for LU j + Real, Save, Allocatable :: rincj ( :,:,: ) ! Rinc for LU j + Real, Save, Allocatable :: deltaj ( :,:,: ) ! Surface wetness for LU j + Real, Save, Allocatable :: ustarj ( :,:,: ) ! u* for LU j + Real, Save, Allocatable :: raj ( :,:,: ) ! aerodynamic resistance for LU j + Real, Save, Allocatable :: laij ( :,:,: ) ! LAI for LU j + Real, Save, Allocatable :: vegj ( :,:,: ) ! veg for LU j + Real, Save, Allocatable :: z0j ( :,:,: ) ! z0 for LU j + Real, Save, Allocatable :: rstomj ( :,:,:,: ) + Real, Save, Allocatable :: rcanj ( :,:,:,: )! stomatal, mesiphyll and cuticular resistances only + Real, Save, Allocatable :: rsurfj ( :,:,:,: )! Rsurf for LU j + Real, Save, Allocatable :: depvel_gasj( :,:,:,: ) ! deposition velocity by land use type + Real, Save, Allocatable :: vd_fst_gasj( :,:,:,: ) ! deposition velocity for stomatal and + Real, Save, Allocatable :: adepvj ( :,:,:,: ) ! deposition velocity for stomatal and + +! Character( 80 ), Save :: LAND_SCHEME + +C Private variables used in this module and subroutines + Integer, Save, Private :: logdev + + Contains + + Subroutine Init_Mosaic( jdate, jtime, ltotg, MOSAIC, ABFLUX ) + + Use HGRD_DEFN + Use LSM_Mod + Use UTILIO_DEFN + + Implicit None + +C...include files + + Include SUBST_FILES_ID ! file name parameters + + Integer, Intent( In ) :: jdate + Integer, Intent( In ) :: jtime + Integer, Intent( In ) :: ltotg + Logical, Intent( In ) :: MOSAIC + Logical, Intent( In ) :: ABFLUX + Character( 240 ) :: xmsg = ' ' + Character( 16 ), save :: pname = 'Init_Mosaic' + Integer l + Integer gxoff, gyoff ! global origin offset from file + Integer :: strtcolgc2, endcolgc2, strtrowgc2, endrowgc2 + + +! LAND_SCHEME = 'UNKNOWN' +! CALL SUBHFILE ( GRID_CRO_2D, GXOFF, GYOFF, +! & STRTCOLGC2, EndCOLGC2, STRTROWGC2, EndROWGC2 ) + +! If ( .Not. DESC3( GRID_CRO_2D ) ) Then +! XMSG = 'COULD NOT GET GRID_CRO_2D FILE DESCRIPTION ' +! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) +! End If + +! Do l = 1, NVARS3D ! determine land character +! If ( VNAME3D( l ) .EQ. 'DLUSE' ) Then +! If ( INDEX( VDESC3D( l ), 'USGS24' ) .Ne. 0 ) LAND_SCHEME = 'USGS24' +! If ( INDEX( VDESC3D( l ), 'MODIS' ) .Ne. 0 ) LAND_SCHEME = 'MODIS' +C...overwrite if NLCD-MODIS scheme +! If ( INDEX( VDESC3D( l ), 'NLCD-MODIS' ) .Ne. 0 ) LAND_SCHEME = 'NLCD-MODIS' +! End If +! End Do +! Write(Logdev,*) 'Land use scheme is ', TRIM(LAND_SCHEME) + + Select Case( LAND_SCHEME ) + Case( 'USGS24' ) +! n_lufrac = n_usgs + rsmin_p => RSMIN_USGS ! array assignment + lai0_p => LAI0_USGS ! " " + laimn0_p => LAIMN0_USGS ! " " + veg0_p => VEG0_USGS ! " " + vegmn0_p => VEGMN0_USGS ! " " + z00_p => Z00_USGS ! " " + luf_fac_p => LUF_FAC_USGS ! " " + Case( 'MODIS' ) +! n_lufrac = n_modis + rsmin_p => RSMIN_MODIS ! array assignment + lai0_p => LAI0_MODIS ! " " + laimn0_p => LAIMN0_MODIS ! " " + veg0_p => VEG0_MODIS ! " " + vegmn0_p => VEGMN0_MODIS ! " " + z00_p => Z00_MODIS ! " " + luf_fac_p => LUF_FAC_MODIS ! " " + Case( 'NLCD50' ) +! n_lufrac = n_nlcd + rsmin_p => RSMIN_NLCD50 ! array assignment + lai0_p => LAI0_NLCD50 ! " " + laimn0_p => LAIMN0_NLCD50 ! " " + veg0_p => VEG0_NLCD50 ! " " + vegmn0_p => VEGMN0_NLCD50 ! " " + z00_p => Z00_NLCD50 ! " " + luf_fac_p => LUF_FAC_NLCD50 ! " " + Case( 'NLCD40' ) +! n_lufrac = n_nlcd + rsmin_p => RSMIN_NLCD40 ! array assignment + lai0_p => LAI0_NLCD40 ! " " + laimn0_p => LAIMN0_NLCD40 ! " " + veg0_p => VEG0_NLCD40 ! " " + vegmn0_p => VEGMN0_NLCD40 ! " " + z00_p => Z00_NLCD40 ! " " + luf_fac_p => LUF_FAC_NLCD40 ! " " + Case Default +! Write(Logdev,*) 'Land use scheme is ', LAND_SCHEME + xmsg = 'Land use scheme not supported' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT2 ) + End Select + z00_p = z00_p / 100.0 ! convert to meters + + If ( .Not. ALLOCATED ( hcanj ) ) Then + ALLOCATE ( hcanj( n_lufrac ) ) + End If + + If ( .Not. ALLOCATED ( lufraccr ) ) Then + ALLOCATE ( lufraccr( n_lufrac ) ) + End If + + If ( .Not. ALLOCATED ( laijcr ) ) Then + ALLOCATE ( laijcr( n_lufrac ) ) + End If + + If ( .Not. ALLOCATED ( vegjcr ) ) Then + ALLOCATE ( vegjcr( n_lufrac ) ) + End If + + If ( .Not. ALLOCATED ( z0jcr ) ) Then + ALLOCATE ( z0jcr( n_lufrac ) ) + End If + + If ( .Not. ALLOCATED ( rbcj ) ) Then + ALLOCATE ( rbcj( n_lufrac ) ) + End If + + If ( .Not. ALLOCATED ( rgndcj ) ) Then + ALLOCATE ( rgndcj( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( rincj ) ) Then + ALLOCATE ( rincj( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( rcanj ) ) Then + ALLOCATE ( rcanj( n_lufrac,ltotg,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( rstomj ) ) Then + ALLOCATE ( rstomj( n_lufrac,ltotg,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( rsurfj ) ) Then + ALLOCATE ( rsurfj( n_lufrac,ltotg,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( deltaj ) ) Then + ALLOCATE ( deltaj( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( ustarj ) ) Then + ALLOCATE ( ustarj( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( raj ) ) Then + ALLOCATE ( raj( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( laij ) ) Then + ALLOCATE ( laij( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( vegj ) ) Then + ALLOCATE ( vegj( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( .Not. ALLOCATED ( z0j ) ) Then + ALLOCATE ( z0j( n_lufrac,my_ncols,my_nrows ) ) + End If + + If ( mosaic .Or. abflux ) Then + If ( .Not. ALLOCATED ( depvel_gasj ) ) + & Allocate ( depvel_gasj( n_lufrac,ltotg,my_ncols,my_nrows ) ) + End If + If ( mosaic ) Then + If ( .Not. ALLOCATED ( vd_fst_gasj ) ) + & Allocate ( vd_fst_gasj( n_lufrac,ltotg,my_ncols,my_nrows ) ) + End If + + Return + + End Subroutine Init_Mosaic + + Subroutine calc_lai( jday, jtime, soit2, lufrac, + & laig, zruf, laicrj, z0crj, vegcrj, logdev, c, r ) + +C*********************************************************************** +C Function: +C Calculate the lai for each LUC in the gridcell + +C Preconditions: none + +C Subroutines and Functions Called: none + +C Revision History: +C*********************************************************************** + + Use LSM_Mod, Only: n_lufrac, Land_Scheme + + Implicit None + +C Arguments: + Integer, Intent( In ) :: jday + Integer, Intent( In ) :: jtime + Real, Intent( In ) :: soit2 ! temeperature in 1 m of soil + Real, Intent( In ) :: lufrac( n_lufrac ) ! fractional land use + Real, Intent( In ) :: laig ! grid value for LAI + Real, Intent( In ) :: zruf ! grid value for roughness + Real, Intent( Out ) :: laicrj( n_lufrac ) + Real, Intent( Out ) :: vegcrj( n_lufrac ) + Real, Intent( Out ) :: z0crj ( n_lufrac ) + Integer, Intent( In ) :: logdev + Integer, Intent( In ) :: c, r ! column, row for reporting errors + +C Local variables: + Real :: arg, arg1, argw + Real :: correction + Integer :: idaype + Real :: fseas + Real :: vseas + Integer :: j + Real :: lai_crop + Real :: lai_mos5, lai_mos6, lai_mos45, lai_mos14 + Real :: new_sum_nat_lai + Real :: root1 + Real :: root2 + Real :: sig + Real :: sum_nat_lai + Real :: sum_mos_lai + Real :: sum_crop_frac + Real :: sum_mos_frac + Real :: sum_lai + Real :: total_frac + Real :: znotc + +C initialize + idaype = 0 + lai_crop = 0.0 + root1 = 0.0 + root2 = 0.0 + sum_nat_lai = 0.0 + sum_mos_lai = 0.0 + sum_crop_frac = 0.0 + sum_mos_frac = 0.0 + total_frac = 0.0 + znotc = 0.0 + +! write(logdev,*) 'in calc-lai: land_scheme, n_lufrac ',land_scheme,n_lufrac + + +C calculate fseas based on deep soil temperature + If ( soit2 .Le. 290.0 ) Then + fseas = MAX( 1.0 - 0.015625 * ( 290.0 - soit2 ) ** 2, 0.0 ) + Else + fseas = 1.0 + End If + +C get individual LAIs for LUCs for this date + Do j = 1, n_lufrac + total_frac = total_frac + lufrac( j ) + vegcrj( j ) = ( ( 1.0 - fseas ) * vegmn0_p( j ) + fseas * veg0_p( j ) )/100. + If ( ( Land_Scheme .EQ. 'USGS24' .And. ( j .Ge. 2 .And. j .LE. 4 ) ) .OR. + & ( Land_Scheme .EQ. 'NLCD50' .And. ( j .EQ. 20 .OR. j .EQ. 43 ) ) .OR. + & ( Land_Scheme .EQ. 'NLCD40' .And. ( j .EQ. 12 .OR. j .EQ. 38 ) ) .OR. + & ( Land_Scheme .EQ. 'MODIS' .And. ( j .EQ. 12 ) ) ) Then + sum_crop_frac = sum_crop_frac + lufrac( j ) + Else If ( ( Land_Scheme .EQ. 'USGS24' .And. ( j .EQ. 5 .OR. j .EQ. 6 ) ) .OR. + & ( Land_Scheme .EQ. 'NLCD50' .And. j .EQ. 45 ).OR. + & ( Land_Scheme .EQ. 'NLCD40' .And. j .EQ. 14 ).OR. + & ( Land_Scheme .EQ. 'MODIS' .And. ( j .EQ. 14 ) ) ) Then + sum_mos_frac = sum_mos_frac + lufrac( j ) + sum_mos_lai = sum_mos_lai + lufrac( j ) * ( laimn0_p( j ) + & + fseas * ( lai0_p( j ) - laimn0_p( j ) ) ) + Else + laicrj( j ) = laimn0_p( j ) + fseas * ( lai0_p( j ) - laimn0_p( j ) ) + sum_nat_lai = sum_nat_lai + lufrac( j ) * laicrj( j ) + z0crj( j ) = z00_p( j ) + End If + End Do + +C total frac needs to be non-water + Select Case(Land_Scheme) + Case('USGS24') + If ( lufrac( 16 ) .Gt. 0.10 ) Then + total_frac = total_frac - lufrac( 16 ) + Else + total_frac = 1.0 + End If + Case('NLCD50') + argw = lufrac( 1 ) + lufrac( 31 ) + lufrac( 48 ) + lufrac( 50 ) + If ( argw .Gt. 0.10 ) Then + total_frac = total_frac - argw + Else + total_frac = 1.0 + End If + Case('NLCD40') + argw = lufrac( 17 ) + lufrac( 21 ) + If ( argw .Gt. 0.10 ) Then + total_frac = total_frac - argw + Else + total_frac = 1.0 + End If + Case('MODIS') + If ( lufrac( 17 ) .Gt. 0.10 ) Then + total_frac = total_frac - lufrac( 16 ) + Else + total_frac = 1.0 + End If + End Select + + If ( ( sum_crop_frac + 0.5 * sum_mos_frac ) .Le. 0.0 ) Then + lai_crop = 0.5 + Else + arg1 = total_frac * laig - sum_nat_lai - 0.5 * sum_mos_lai + +#ifdef Verbose + If ( arg1 .Le. 0.0 ) Then + Write( logdev,* ) ' ' + Write( logdev,'(a, 2i4)' ) 'Sum Natural+Mosaic LAI too big at c,r: ', c, r + Write( logdev,* ) 'arg1,total_frac,laig : ', arg1, total_frac, laig + Write( logdev,* ) 'soit2,fseas : ', soit2, fseas + Write( logdev,* ) 'sum_nat_lai,sum_mos_lai : ', sum_nat_lai, sum_mos_lai + Write( logdev,* ) 'sum_crop_frac, sum_mos_frac : ', sum_crop_frac, sum_mos_frac + Write( logdev,* ) ' ' + End If +#endif + + lai_crop = arg1 / ( sum_crop_frac + 0.5 * sum_mos_frac ) + +#ifdef Verbose + If ( lai_crop .Gt. 3.16 ) Then + Write( logdev,* ) ' ' + Write( logdev,'(a, 2i4, a, f12.5)' ) 'CROP LAI too big at c,r: ', c, r, ' lai crop = ', lai_crop + Write( logdev,* ) 'arg1,total_frac,laig : ', arg1, total_frac, laig + Write( logdev,* ) 'soit2,fseas : ', soit2, fseas + Write( logdev,* ) 'sum_nat_lai,sum_mos_lai : ', sum_nat_lai, sum_mos_lai + Write( logdev,* ) 'sum_crop_frac, sum_mos_frac : ', sum_crop_frac, sum_mos_frac + Write( logdev,* ) ' ' + End If +#endif + +C check to see if correction needed + If ( lai_crop .Lt. 0.5 .OR. lai_crop .Gt. 3.16 ) Then ! method didn't work - numerical error - use approximation based on fseas + +#ifdef Verbose + Write( logdev,'(a, 2i4, a, f12.5)' ) 'Numerical error in Calc_LAI at c,r: ', c, r, ' - bad lai_crop = ', lai_crop +#endif + Select Case(Land_Scheme) + Case('USGS24') + lai_crop = MAX( laimn0_p( 2 ) + fseas * ( 3.16 - laimn0_p( 2 ) ), 0.5 ) ! max lai-crop is really 3.16 not 3.0 as in table + Case('NLCD50') ! since values are the same for LUC 20 and 43 only need one + lai_crop = MAX( laimn0_p( 20 ) + fseas * ( 3.16 - laimn0_p( 20 ) ), 0.5 ) + Case('NLCD40') ! since values are the same for LUC 12 and 38 only need one + lai_crop = MAX( laimn0_p( 38 ) + fseas * ( 3.16 - laimn0_p( 38 ) ), 0.5 ) + Case('MODIS') + lai_crop = MAX( laimn0_p( 12 ) + fseas * ( 3.16 - laimn0_p( 12 ) ), 0.5 ) + End Select + +#ifdef Verbose + Write( logdev,'(47x, a, f12.5)' ) 'New lai_crop = ', lai_crop +#endif + + Select Case(Land_Scheme) + Case('USGS24') + lai_mos5 = 0.5 * ( laimn0_p( 5 ) + fseas * ( lai0_p( 5 ) - laimn0_p( 5 ) ) ) + 0.5 * lai_crop + lai_mos6 = 0.5 * ( laimn0_p( 6 ) + fseas * ( lai0_p( 6 ) - laimn0_p( 6 ) ) ) + 0.5 * lai_crop + new_sum_nat_lai = total_frac * laig - ( lai_crop * sum_crop_frac + lai_mos5 * lufrac( 5 ) + + & lai_mos6 * lufrac( 6 ) ) + Case('NLCD50') + lai_mos45 = 0.5 * ( laimn0_p( 45 ) + fseas * ( lai0_p( 45 ) - laimn0_p( 45 ) ) ) + 0.5 * lai_crop + new_sum_nat_lai = total_frac * laig - ( lai_crop * sum_crop_frac + lai_mos45* lufrac( 45 ) ) + Case('NLCD40') + lai_mos14 = 0.5 * ( laimn0_p( 14 ) + fseas * ( lai0_p( 14 ) - laimn0_p( 14 ) ) ) + 0.5 * lai_crop + new_sum_nat_lai = total_frac * laig - ( lai_crop * sum_crop_frac + lai_mos14* lufrac( 14 ) ) + Case('MODIS') + lai_mos14 = 0.5 * ( laimn0_p( 14 ) + fseas * ( lai0_p( 14 ) - laimn0_p( 14 ) ) ) + 0.5 * lai_crop + new_sum_nat_lai = total_frac * laig - ( lai_crop * sum_crop_frac + lai_mos14 * lufrac( 14 ) ) + End Select + + If ( sum_nat_lai .Lt. 0.1 .OR. new_sum_nat_lai .LT. 0.1 ) Then ! not worth doing a correction + correction = 1.0 + Else + correction = new_sum_nat_lai / sum_nat_lai + End If + +#ifdef Verbose + Select Case(Land_Scheme) + Case('USGS24') + Write( logdev,* ) 'Old lai: ', laicrj( 1 ), laicrj( 7 ), laicrj( 11 ), laicrj( 15 ) + Case('NLCD50') + Write( logdev,* ) 'Old lai: ', laicrj( 1 ), laicrj( 14 ), laicrj( 9 ), laicrj( 11 ) + Case('NLCD40') + Write( logdev,* ) 'Old lai: ', laicrj( 17 ), laicrj( 10 ), laicrj( 4 ), laicrj( 5 ) + Case('MODIS') + Write( logdev,* ) 'Old lai: ', laicrj( 17 ), laicrj( 10 ), laicrj( 4 ), laicrj( 5 ) + End Select + Write( logdev,* ) 'correction = ', correction +#endif + + Select Case(Land_Scheme) + Case('USGS24') + laijcr( 1 ) = laicrj( 1 ) * correction + Do j = 7, 15 + laijcr( j ) = laicrj( j ) * correction + End do +#ifdef Verbose + Write( logdev,* ) 'New lai: ', laicrj( 1 ), laicrj( 7 ), laicrj( 11 ), laicrj( 15 ) +#endif + Case('NLCD50') + Do j = 2, 19 + laicrj( j ) = laicrj( j ) * correction + End Do + Do j = 21, 30 + laicrj( j ) = laicrj( j ) * correction + End Do + Do j = 32, 42 + laicrj( j ) = laicrj( j ) * correction + End Do + laicrj( 44 ) = laicrj( 44 ) * correction + laicrj( 46 ) = laicrj( 46 ) * correction + laicrj( 47 ) = laicrj( 47 ) * correction + Case('NLCD40') + Do j = 1, 11 + laicrj( j ) = laicrj( j ) * correction + End Do + laicrj( 13 ) = laicrj( 13 ) * correction + Do j = 15, 16 + laicrj( j ) = laicrj( j ) * correction + End Do + Do j = 22, 40 + laicrj( j ) = laicrj( j ) * correction + End Do + Case('MODIS') + Do j = 1, 11 + laicrj( j ) = laicrj( j ) * correction + End Do + laicrj( 13 ) = laicrj( 13 ) * correction + Do j = 15, 16 + laicrj( j ) = laicrj( j ) * correction + End Do + Do j = 18, 20 + laicrj( j ) = laicrj( j ) * correction + End Do + End Select + End If ! correction needed + + End If + +c estimate vseas + vseas = (lai_crop-0.5)/2.5 + vseas = min(max(vseas,0.0),1.0) + +C find z0_crop by finding days past emergence + sig = ( ( lai_crop ) ** ( 1.0 / 1.923 ) ) / 2.273 + arg = 0.0184 * 0.0184 - 4.0 * 1.057e-4 * sig + root1 = ( 0.0184 + SQRT( arg ) ) / ( 2.0 * 1.057E-4 ) + root2 = ( 0.0184 - SQRT( arg ) ) / ( 2.0 * 1.057E-4 ) +C figure out which root to use - PX assumes maturity 87 days after emergence +C which should have been caught by testing lai + If ( root1 .Gt. 87.0 ) root1 = 0.0 + If ( root2 .Gt. 87.0 ) root2 = 0.0 + idaype = NINT( MAX( root1, root2 ) ) + If ( idaype .Le. 0 .OR. jday .Gt. 288 ) Then + znotc = 0.05 + Else If ( idaype .Gt. 87 ) Then + znotc = 0.15 + Else + znotc = 5.00 + 0.23 * REAL( idaype ) - 1.32E-3 * REAL( idaype * idaype ) + znotc = znotc / 100.0 ! convert to meters + End If + + Select Case(Land_Scheme) + Case('USGS24') + Do j = 2, 4 + laicrj( j ) = lai_crop + z0crj( j ) = znotc + vegcrj( j ) = ((1.-vseas)*vegmn0_p(j) + vseas*veg0_p(j))/100.0 + End Do + + Do j = 5, 6 + laicrj( j ) = 0.5 * ( laimn0_p( j ) + fseas * ( lai0_p( j ) - laimn0_p( j ) ) ) + & + 0.5 * lai_crop + z0crj( j ) = 0.5 * ( znotc + z00_p( j ) ) + vegcrj( j ) = ( (1.0-vseas) * vegmn0_p(j) + vseas * veg0_p(j) ) / 100.0 + End Do + Case('NLCD50') + laicrj( 20 ) = lai_crop + z0crj ( 20 ) = znotc + vegcrj( 20 ) = ( (1.0-vseas) * vegmn0_p(20) + vseas * veg0_p(20) ) / 100.0 + laicrj( 43 ) = lai_crop + z0crj ( 43 ) = znotc + vegcrj( 43 ) = ( (1.0-vseas) * vegmn0_p(43) + vseas * veg0_p(43) ) / 100.0 + laicrj( 45 ) = 0.5 * ( laimn0_p( 45 ) + fseas * ( lai0_p( 45 ) - laimn0_p( 45 ) ) ) + & + 0.5 * lai_crop + z0crj ( 45 ) = 0.5 * ( znotc + z00_p( 45 ) ) + vegcrj( 45 ) = ( (1.0-vseas) * vegmn0_p(45) + vseas * veg0_p(45) ) / 100.0 + Case('NLCD40') + laicrj( 12 ) = lai_crop + z0crj ( 12 ) = znotc + vegcrj( 12 ) = ( (1.0-vseas) * vegmn0_p(12) + vseas * veg0_p(12) ) / 100.0 + laicrj( 14 ) = 0.5 * ( laimn0_p( 14 ) + fseas * ( lai0_p( 14 ) - laimn0_p( 14 ) ) ) + & + 0.5 * lai_crop + z0crj ( 14 ) = 0.5 * ( znotc + z00_p( 14 ) ) + vegcrj( 14 ) = ( (1.0-vseas) * vegmn0_p(14) + vseas * veg0_p(14) ) / 100.0 + laicrj( 38 ) = lai_crop + z0crj ( 38 ) = znotc + vegcrj( 38 ) = ( (1.0-vseas) * vegmn0_p(12) + vseas * veg0_p(12) ) / 100.0 + Case('MODIS') + laicrj( 12 ) = lai_crop + z0crj ( 12 ) = znotc + vegcrj( 12 ) = ( (1.0-vseas) * vegmn0_p(12) + vseas * veg0_p(12) ) / 100.0 + laicrj( 14 ) = 0.5 * ( laimn0_p( 14 ) + fseas * ( lai0_p( 14 ) - laimn0_p( 14 ) ) ) + & + 0.5 * lai_crop + z0crj ( 14 ) = 0.5 * ( znotc + z00_p( 14 ) ) + vegcrj( 14 ) = ( (1.0-vseas) * vegmn0_p(14) + vseas * veg0_p(14) ) / 100.0 + End Select + + sum_lai = SUM( laicrj * lufrac ) + +#ifdef Verbose + If ( ( sum_lai - laig ) / laig .Gt. 0.05 ) Then + Write( logdev,* ) ' ' + Write( logdev,* ) 'Error in total LAI' + Write( logdev,* ) 'LAI grid = ', laig, ' LAI mosaic = ', sum_lai + Write( logdev,* ) ' ' + End If +#endif + + Return + + End Subroutine Calc_LAI + + Subroutine RA_MM5( WS10, US, VS, THETA, THETAV, TG, QVS, QSS, SNOW, PSFPA, + & LWMASK, WG, WFC, Z, ZNT, UST, RA, rich, psih, betap, hu, dthvdz ) + + Implicit None + + Real US,VS,THETA, THETAV, TG, QVS, QSS, SNOW, PSFPA, LWMASK, WG, WFC, Z, ZNT, UST, RA + Real BETAH, GAMAH, PR0, BH, RICRIT, CZO, OZO, CP, R, ROVCP, EP1, G, ROVG, KARMAN, PI + Real HU, BETAP, QFC, CVIRT, TV0, CPOT, TH0, THETAG, CPAIR + Real RICRITI, WS, GZ1OZ0, DTHVDZ, DTHVM, VCONV, WSPD, GOVRTH, RICH, RICUT + Real ZOL, PSIH, AH, SQLNZZ0 + Real PSURF + Real WS10 + Integer ISNOW, ISTI + +C Calculate Ra via the richardson number as done for MM5 + + Data BETAH/ 8.21 /, GAMAH/ 11.6 /, PR0/ 0.95 / + Data BH/ 15.7 / + + Data RICRIT/ 0.25 / + Data CZO/ 0.032 /, OZO/ 0.0001 / + Data KARMAN/ 0.4 / + + Save BETAH, GAMAH, PR0, BH, RICRIT, CZO, OZO, KARMAN + +C from param.F + CP = 1004.E0 + R = 287.04 + ROVCP = R / CP + EP1 = 0.608 + G = 9.81 + ROVG = R / G + PI = 4.0 * ATAN( 1.0 ) + + ISNOW = NINT( SNOW ) + ISNOW = MAX( 0, ISNOW ) + + ISTI = NINT( LWMASK ) + PSURF = PSFPA / 100.0 ! CONVERT TO MB + +C +C-- compute sfc rh from soil moisture +C* SATURATED FOR WATER SURFACE AND SNOW (ISNOW=1) + HU = 1.0 + BETAP = 1.0 +C* +C-- FOR SURFACE OVER LAND + +C..... beta method, Lee & Pielke (JAM,May1992) + If ( ISTI .Ne. 0 .And. ISNOW .Ne. 1 .And. WFC .Gt. 0. .And. WG .Le. WFC ) Then + BETAP = 0.25 * ( 1.0 - COS( WG / WFC * PI) )**2 + HU = BETAP + (1.0 - BETAP) * QVS / QSS + End If + + QFC = HU * QSS + +C.......... compute the thetav at ground + CVIRT = ( 1.0 + EP1 * QFC ) + TV0 = TG *CVIRT + CPOT = ( 1000.0 / PSURF )**ROVCP ! psurf needs to be in mb + TH0 = TV0 * CPOT +! THETAG = CPOT * TG +! CPAIR = 1004.67 * (1.0 + 0.84 * QVS) ! J/(K KG) + +C +C-----CALCULATE BULK RICHARDSON NO. OF SURFACE LAYER, ACCORDING TO +C AKB(1976), EQ(12). +C + RICRITI = 1.0 / RICRIT + GZ1OZ0 = LOG( Z / ZNT ) + WS = SQRT( US*US + VS*VS ) +! WS = WS10 + DTHVDZ = THETAV - TH0 + DTHVM = MAX( -DTHVDZ, 0.0 ) + VCONV = 2.0 * SQRT( DTHVM ) + WSPD = SQRT( WS*WS + VCONV*VCONV ) + WSPD = MAX( WSPD, 1.0 ) + GOVRTH = G / THETA + RICH = GOVRTH * Z * DTHVDZ / ( WSPD * WSPD ) + RICUT = 1.0 / ( RICRITI + GZ1OZ0 ) + +C------------------------------------------------------------------ +C-- NOTE THAT THE REGIMES USED IN HIRPBL HAVE BEEN CHANGED: +C-- USE PLEIM(2006) TO CALCULATE PSI + ZOL = 0.0 + If ( RICH .Ge. RICUT ) Then + +C-----CLASS 1; VERY STABLE CONDITIONS: Z/L > 1 + + ZOL = RICH*GZ1OZ0/(1-RICRITI*RICUT) + PSIH = 1.-BETAH-ZOL + + Else If (RICH .Ge. 0.0 ) Then + +C-----CLASS 2; STABLE: for 1 > Z/L >0 + + ZOL = RICH*GZ1OZ0/(1-RICRITI*RICH) + PSIH = -BETAH * ZOL + + Else + +C-----CLASS 3 or 4; UNSTABLE: +C CLASS 4 IS FOR ACM NON-LOCAL CONVECTION (H/L < -3) + + AH=0.04+0.355*ALOG(GZ1OZ0) + SQLNZZ0=SQRT(GZ1OZ0) + PSIH = AH*ALOG(1.-BH*SQLNZZ0*RICH) + + End If + + RA = PR0*(GZ1OZ0-PSIH)/(KARMAN*UST) + + Return + End Subroutine RA_MM5 + + Subroutine RA_WRF ( moli, zol, zntol, zh, ustar, z0crj, j, c, r ) + + Implicit None + + Real, Intent( In ) :: moli, zol, zntol,zh, ustar, z0crj + Integer, Intent( IN ) :: j, c, r + + Real y, ynt, psih, alogz1z0 + + Real, Parameter :: betah = 5.0 ! WRF uses Dyer + Real, Parameter :: gamah = 16.0 ! WRF uses Dyer + Real, Parameter :: pr0 = 0.95 ! Prandtl number for neutral stability + Real, Parameter :: karman = 0.4 ! von Karman constant + + If ( moli .Lt. 0.0 ) Then + y = Sqrt( 1.0 - gamah * zol ) + ynt = Sqrt( 1.0 - gamah * zntol ) + psih = 2.0 * Log( ( y + 1.0 ) / ( ynt + 1.0 ) ) + Else + If ( ( zol - zntol ) .Le. 1.0 ) Then + psih = -betah * ( zol - zntol ) + Else + psih = 1.0 - betah - ( zol - zntol ) + End If + End If + alogz1z0 = Log( zh / z0crj ) + raj(j,c,r) = pr0 * ( alogz1z0 - psih ) / ( karman * ustar ) ! update the shared array + + Return + End Subroutine RA_WRF + + End Module Mosaic_Mod + + + diff --git a/models/CCTM/depv/blank/cgrid_depv.F b/models/CCTM/depv/blank/cgrid_depv.F new file mode 100755 index 0000000..bec7822 --- /dev/null +++ b/models/CCTM/depv/blank/cgrid_depv.F @@ -0,0 +1,194 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/cgrid_depv.F,v 1.4 2011/10/21 16:10:37 yoj Exp $ + +C RCS file, release, date & time of last delta, author, state, [and locker] +C $Header: /project/yoj/arc/CCTM/src/depv/m3dry/cgrid_depv.F,v 1.4 2011/10/21 16:10:37 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE CGRID_DEPV( GAS_DEPV_FOUND, GAS_DEPV_SUR, CGRID, CGRIDL1 ) + +C----------------------------------------------------------------------- +C Return layer one CGRID concentrations for the gas depv species with species +C first in the dimensions order - called by GET_DEPV [DEPV_DEFN module] to +C use for bi-directional flux calculations in m3dry +C Revision History: +C Jeff Young 11 Jan 07: created +C 21 Jun 10 J.Young: convert for Namelist redesign +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN; +C----------------------------------------------------------------------- + + USE CGRID_SPCS ! CGRID mechanism species + USE HGRD_DEFN ! horizontal domain specifications + USE UTILIO_DEFN + +C Arguments: + + LOGICAL, INTENT( IN ) :: GAS_DEPV_FOUND( : ) + INTEGER, INTENT( IN ) :: GAS_DEPV_SUR( : ) + REAL, POINTER :: CGRID( :,:,:,: ) + REAL, INTENT( OUT ) :: CGRIDL1( :,:,: ) + +C Local Variables: + + LOGICAL, SAVE :: FIRSTIME = .TRUE. + integer, save :: logdev + + INTEGER C, R, S, N, V, NDX, STRT + +C----------------------------------------------------------------------- + IF ( FIRSTIME ) THEN + FIRSTIME = .FALSE. + logdev = init3() + END IF + + N = 0 + STRT = 0 + DO V = 1, N_GC_DEPV + N = N + 1 + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + S = STRT + GC_DEPV_MAP( V ) + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + CGRIDL1( NDX,C,R ) = CGRID( C,R,1,S ) + END DO + END DO + END IF +! write( logdev,* ) strt, v, n, ndx, s + END DO + + STRT = N_GC_SPC + 1 + N_AE_SPC ! +1 for RHOJ + DO V = 1, N_NR_DEPV + N = N + 1 + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + S = STRT + NR_DEPV_MAP( V ) + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + CGRIDL1( NDX,C,R ) = CGRID( C,R,1,S ) + END DO + END DO + END IF +! write( logdev,* ) strt, v, n, ndx, s + END DO + + STRT = N_GC_SPC + 1 + N_AE_SPC + N_NR_SPC + DO V = 1, N_TR_DEPV + N = N + 1 + IF ( GAS_DEPV_FOUND( N ) ) THEN + NDX = GAS_DEPV_SUR( N ) + S = STRT + TR_DEPV_MAP( V ) + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + CGRIDL1( NDX,C,R ) = CGRID( C,R,1,S ) + END DO + END DO + END IF +! write( logdev,* ) strt, v, n, ndx, s + END DO + + END SUBROUTINE CGRID_DEPV + +C for cb05: +C strt v n ndx s GAS_DEPV_FOUND GAS_DEPV_SUR +C 0 1 1 3 1 (1) .true. 3 VD_NO2 +C 0 2 2 4 2 (2) .true. 4 VD_NO +C 0 3 3 5 4 (3) .true. 5 VD_O3 +C 0 4 4 19 5 (4) .true. 19 VD_NO3 +C 0 5 5 18 9 (5) .true. 18 VD_N2O5 +C 0 6 6 6 10 (6) .true. 6 VD_HNO3 +C 0 7 7 15 11 (7) .true. 15 VD_HONO +C 0 8 8 7 13 (8) .true. 7 VD_H2O2 +C 0 9 9 14 16 (9) .true. 14 VD_PAN +C 0 10 10 10 17 (10) .true. 10 VD_OP +C 0 11 11 9 18 (11) .true. 9 VD_HCHO +C 0 12 12 8 19 (12) .true. 8 VD_ALD +C 0 13 13 20 20 (13) .true. 20 VD_GEN_ALD +C 0 14 14 16 22 (14) .true. 16 VD_CO +C x 0 15 15 16 22 (15) .false. 10 VD_OP +C 0 16 16 17 25 (16) .true. 17 VD_METHANOL +C 0 17 17 12 27 (17) .true. 12 VD_ORA +C x 0 18 18 12 27 (18) .false. 14 VD_PAN +C 0 19 19 11 30 (19) .true. 11 VD_PAA +C x 0 20 20 11 30 (20) .false. 12 VD_ORA +C x 0 21 21 11 30 (21) .false. 14 VD_PAN +C 0 22 22 1 52 (22) .true. 1 VD_SO2 +C 0 23 23 2 53 (23) .true. 2 VD_SULF +C 91 1 24 13 92 (24) .true. 13 VD_NH3 +C x 91 2 25 13 92 (25) .false. 12 VD_ORA +C x 91 3 26 13 92 (26) .false. 12 VD_ORA +C x 91 4 27 13 92 (27) .false. 12 VD_ORA +C x 91 5 28 13 92 (28) .false. 12 VD_ORA +C x 91 6 29 13 92 (29) .false. 12 VD_ORA +C x 91 7 30 13 92 (30) .false. 12 VD_ORA +C x 91 8 31 13 92 (31) .false. 12 VD_ORA +C x 91 9 32 13 92 (32) .false. 12 VD_ORA +C x 91 10 33 13 92 (33) .false. 12 VD_ORA +C x 91 11 34 13 92 (34) .false. 12 VD_ORA +C 91 12 35 21 103 (35) .true. 21 VD_HCL + +C for cb05cl: +C strt v n ndx s GAS_DEPV_FOUND GAS_DEPV_SUR +C 0 1 1 3 1 .true. 3 VD_NO2 +C 0 2 2 4 2 .true. 4 VD_NO +C 0 3 3 5 4 .true. 5 VD_O3 +C 0 4 4 19 5 .true. 19 VD_NO3 +C 0 5 5 18 9 .true. 18 VD_N2O5 +C 0 6 6 6 10 .true. 6 VD_HNO3 +C 0 7 7 15 11 .true. 15 VD_HONO +C 0 8 8 7 13 .true. 7 VD_H2O2 +C 0 9 9 14 16 .true. 14 VD_PAN +C 0 10 10 10 17 .true. 10 VD_OP +C 0 11 11 9 18 .true. 9 VD_HCHO +C 0 12 12 8 19 .true. 8 VD_ALD +C 0 13 13 20 20 .true. 20 VD_GEN_ALD +C 0 14 14 16 22 .true. 16 VD_CO +C 0 15 15 16 22 .false. 10 VD_OP +C 0 16 16 17 25 .true. 17 VD_METHANOL +C 0 17 17 12 27 .true. 12 VD_ORA +C 0 18 18 12 27 .false. 14 VD_PAN +C 0 19 19 11 30 .true. 11 VD_PAA +C 0 20 20 11 30 .false. 12 VD_ORA +C 0 21 21 11 30 .false. 14 VD_PAN +C 0 22 22 1 52 .true. 1 VD_SO2 +C 0 23 23 2 53 .true. 2 VD_SULF +C 0 24 24 21 57 .true. 21 VD_CL2 +C 0 25 25 22 59 .true. 22 VD_HOCL +C 0 26 26 24 61 .true. 24 VD_FMCL +C 0 27 27 23 62 .true. 23 VD_HCL +C 122 1 28 13 123 .true. 13 VD_NH3 +C 122 2 29 13 123 .false. 12 VD_ORA +C 122 3 30 13 123 .false. 12 VD_ORA +C 122 4 31 13 123 .false. 12 VD_ORA +C 122 5 32 13 123 .false. 12 VD_ORA +C 122 6 33 13 123 .false. 12 VD_ORA +C 122 7 34 13 123 .false. 12 VD_ORA +C 122 8 35 13 123 .false. 12 VD_ORA +C 122 9 36 13 123 .false. 12 VD_ORA +C 122 10 37 13 123 .false. 12 VD_ORA +C 122 11 38 13 123 .false. 12 VD_ORA +C 122 12 39 13 123 .false. 12 VD_ORA +C 122 13 40 13 123 .false. 12 VD_ORA + diff --git a/models/CCTM/depv/blank/gas_depv_map.F b/models/CCTM/depv/blank/gas_depv_map.F new file mode 100755 index 0000000..6e5660a --- /dev/null +++ b/models/CCTM/depv/blank/gas_depv_map.F @@ -0,0 +1,205 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/gas_depv_map.F,v 1.5 2011/10/21 16:10:38 yoj Exp $ + +C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE GAS_DEPV_MAP ( N_DEPV_NAMES, DEPV_NAMES, DEPV_SUR ) + +C---------------------------------------------------------------------- +C 21 Jun 10 J.Young: convert for Namelist redesign +C 16 Feb 2011 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C---------------------------------------------------------------------- + + USE CGRID_SPCS ! CGRID mechanism species + USE DEPVVARS + USE UTILIO_DEFN + + IMPLICIT NONE + +C Arguments: + + INTEGER, INTENT( IN ) :: N_DEPV_NAMES ! number of unique dep vel species + CHARACTER( 16 ), INTENT( INOUT ) :: DEPV_NAMES( : ) ! names of dep vel species + INTEGER, INTENT( OUT ) :: DEPV_SUR( : ) ! pointers to model species for + ! calculated deposition velocities + ! (surrogate dep vels [m/s**2]) + +C Local variables: + + INTEGER :: JDATE = 0 + INTEGER :: JTIME = 0 + + CHARACTER( 16 ), SAVE :: PNAME = 'GAS_DEPV_MAP' + + CHARACTER( 96 ) :: XMSG = ' ' + CHARACTER( 16 ) :: VNAME ! scratch string + + INTEGER LOGDEV + INTEGER ALLOCSTAT + INTEGER V, N + INTEGER STRT, FINI + +C---------------------------------------------------------------------- + + LOGDEV = INIT3() + + IF ( ( N_GC_SPC + N_NR_SPC + N_TR_SPC ) .LE. 0 ) THEN + XMSG = 'Model not compiled for gases' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Set up names and indices + + IF ( .NOT. DEPVVARS_INIT( ) ) THEN + XMSG = 'Failure initializing depvvars module' + CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + +C Set up the DEPV pointers to calculated deposition velocities + +#ifdef Verbose + WRITE( LOGDEV,* ) ' ' + WRITE( LOGDEV,* ) ' > Unique DEPV versus DEPSPC' +#endif + + DO V = 1, N_DEPV_NAMES + VNAME = DEPV_NAMES( V )( 4:LEN_TRIM( DEPV_NAMES( V ) ) ) + N = INDEX1( VNAME, LTOTG, DEPSPC ) + IF ( N .NE. 0 ) THEN + IF ( .NOT. USE_DEPSPC( N ) ) THEN + USE_DEPSPC( N ) = .TRUE. + N_USE_DEPSPC = N_USE_DEPSPC + 1 +#ifdef Verbose + WRITE( LOGDEV,1005 ) V, DEPV_NAMES( V ), N, DEPSPC( N ) +#endif + END IF + ELSE + XMSG = 'Could not find ' // TRIM( DEPV_NAMES( V ) ) // + & ' in ' // TRIM( DEPV_METHOD ) // + & ' surrogate table.' +! & ' surrogate table. >>> Dep vel set to zero <<< ' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + +C Sort DEPV_NAMES based on the order in DEPSPC (DEPVVARS module) + +#ifdef Verbose + WRITE( LOGDEV,* ) ' ' + WRITE( LOGDEV,* ) ' > Sorted DEPV names (1st index from total m3dry list)' +#endif + + N = 0 + DO V = 1, LTOTG +! IF ( .NOT. USE_DEPSPC( V ) ) CYCLE + IF ( .NOT. USE_DEPSPC( V ) ) THEN +#ifdef Verbose + WRITE( LOGDEV,1009 ) V, USE_DEPSPC( v ), 0, ' ' +#endif + ELSE + N = N + 1 + VNAME = 'VD_' // DEPSPC( V )( 1:LEN_TRIM( DEPSPC( V ) ) ) + DEPV_NAMES( N ) = VNAME +#ifdef Verbose + WRITE( LOGDEV,1009 ) V, USE_DEPSPC( V ), N, DEPV_NAMES( N ) +#endif + END IF + END DO + +C Locate model species' DEPVs in the unique DEPV_NAMES list + + DO V = 1, N_GC_DEPV + VNAME = GC_DEPV( V ) + N = INDEX1( VNAME, N_DEPV_NAMES, DEPV_NAMES ) + IF ( N .NE. 0 ) THEN + DEPV_SUR( V ) = N + ELSE + XMSG = 'Could not find ' // TRIM( GC_DEPV( V ) ) + & // ' in DEPV table.' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + + STRT = N_GC_DEPV + 1 + FINI = N_GC_DEPV + N_NR_DEPV + DO V = STRT, FINI + VNAME = NR_DEPV( V - ( STRT-1 ) ) + N = INDEX1( VNAME, N_DEPV_NAMES, DEPV_NAMES ) + IF ( N .NE. 0 ) THEN + DEPV_SUR( V ) = N + ELSE + XMSG = 'Could not find ' // TRIM( NR_DEPV( V ) ) + & // ' in DEPV table.' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + + STRT = N_GC_DEPV + N_NR_DEPV + 1 + FINI = N_GC_DEPV + N_NR_DEPV + N_TR_DEPV + DO V = STRT, FINI + VNAME = TR_DEPV( V - (STRT-1) ) + N = INDEX1( VNAME, N_DEPV_NAMES, DEPV_NAMES ) + IF ( N .NE. 0 ) THEN + DEPV_SUR( V ) = N + ELSE + XMSG = 'Could not find ' // TRIM( TR_DEPV( V ) ) + & // ' in DEPV table.' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + END DO + +#ifdef Verbose + WRITE( LOGDEV,* ) ' ' + WRITE( LOGDEV,* ) ' > ', PNAME, 'Final Gas DEPV Map' + + STRT = 0 + DO V = 1, N_GC_DEPV + WRITE( LOGDEV,1019 ) V, GC_DEPV( V ), DEPV_SUR( V+STRT ), + & DEPV_NAMES( DEPV_SUR( V+STRT) ) + END DO + + STRT = N_GC_DEPV + DO V = 1, N_NR_DEPV + WRITE( LOGDEV,1019 ) V, NR_DEPV( V ), DEPV_SUR( V+STRT ), + & DEPV_NAMES( DEPV_SUR( V+STRT) ) + END DO + + STRT = N_GC_DEPV + N_NR_DEPV + DO V = 1, N_TR_DEPV + WRITE( LOGDEV,1019 ) V, TR_DEPV( V ), DEPV_SUR( V+STRT ), + & DEPV_NAMES( DEPV_SUR( V+STRT) ) + END DO +#endif + + RETURN + + RETURN + +1005 FORMAT( I5, 1X, A16, I3, 1X, A16 ) + +!009 FORMAT( I5, 1X, I4, 1X, A16 ) +1009 FORMAT( I5, 1X, L3, 1X, I4, 1X, A16 ) + +1019 FORMAT( 3( I3, 1X, A16, 1X ) ) + + END SUBROUTINE GAS_DEPV_MAP + diff --git a/models/CCTM/depv/blank/m3dry.F b/models/CCTM/depv/blank/m3dry.F new file mode 100755 index 0000000..fa30ee2 --- /dev/null +++ b/models/CCTM/depv/blank/m3dry.F @@ -0,0 +1,1719 @@ + +!------------------------------------------------------------------------! +! 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/depv/m3dry/m3dry.F,v 1.12 2012/01/19 14:19:43 yoj Exp $ + +C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE m3dry ( jdate, jtime, dt, abflux, sfc_hono, mosaic, fst, cgridl1, depvel_gas, + & pvd, cmp ) + +C------------------------------------------------------------------------------- +C Name: Models-3 Dry Deposition +C Purpose: Computes dry deposition velocities using Rst and Ra, and +C elements of ADOM DD model. +C Revised: 21 Jan 1998 Original version. (J. Pleim and A. Bourgeois) +C 18 Sep 2001 Made general for USGS 24-category system. +C (T. Otte, J. Pleim, and W. Hutzell) +C 14 Jan 2002 Added temperature dependence to Henry's Law +C constants. Added temperature and pressure +C dependence to diffusivity. Added new dry +C deposition species, methanol. (Y. Wu and T. Otte) +C 18 Jan 2002 Changed the reference wet cuticle resistance. +C (J. Pleim) +C 09 Jun 2003 Added logic for modeling snow covered surfaces. +C Changed the reactivities for SO2, HNO3 and NH3. +C Changed pH values to have an east-west variation. +C Using the Henry's law constant function from CMAQ in +C place of local code. Also changed the code for +C deposition to water to use a pH of 8.1 and the +C temperature of water in calculating the Henry's law +C constant. Adjusted values of RSNOW0 = 1000 and +C A(NH3) = 20. Added new dry deposition species: N2O5, +C NO3, Generic_aldehyde. Corrected diffusivities of +C chemicals and water and viscosity of air to all be at +C the same temperature (273.15K). Temperature and +C pressure adjustments to the values are not needed +C because the diffusivities and viscosity are always used +C as ratios, so the temperature-pressure dependence was +C removed. Removed dry deposition species, ATRA and +C ATRAP, from output. (D. Schwede, J. Pleim, and +C T. Otte) +C 28 Feb 2005 Added optional dry deposition species for chlorine +C and mercury. (G. Sarwar, R. Bullock, and T. Otte) +C 02 Feb 2006 Added mesophyll resistance to dry deposition velocity +C calculation, and defined non-zero value for mercury. +C (D. Schwede, J. Pleim, and R. Bullock) +C 01 Aug 2007 Added a non-zero mesophyll resistance for NO, NO2, and +C CO. Restored wet cuticle resistance for O3 based on +C field study measurements. Added wet ground resistance. +C Changed ground resistance to include partitioning of +C wet and dry ground. Updated pH of rain water for +C eastern United States and outside of North America. +C Changed reactivity for PAN. Removed dry deposition +C velocity calculations for obsolete chlorine species +C ICL1 and ICL2. Corrected error in the calculation of +C surface resistance over water where (Sc/Pr)**(2/3) had +C been inadvertently omitted from the numerator. +C Surface resistance over water is now a function of +C species. Surface resistance over water now uses wet +C bulb temperature rather than ground (water) temperature +C in the calculation of the effective Henry's law +C constant, and the algorithm has been updated. Changed +C (Sc/Pr)**(2/3) over water to a species-dependent, +C meteorologically dependent variable. Effective Henry's +C law constant over land now uses 2-m temperature rather +C than layer 1 temperature. Changed ES +C into ES_AIR and ES_GRND, and changed QSS into QSS_AIR +C and QSS_GRND to clarify usage. (J. Pleim, E. Cooter, +C J. Bash, T. Otte, and G. Sarwar) +C 07 Dec 2007 Add into CMAQ for in-line deposition velocities. +C (W. Hutzell, J. Young and T. Otte) +C 07 Jan 2008 Changed the value of d3, the scaling parameter used to +C estimate the friction velocity in surface waters from +C the atmospheric friction velocity to a value following +C Slinn et al. (1978) and Fairall et al. (2007). +C (J. Bash) +C 01 Feb 2008 Added bidirectional NH3 flux calculations. (J. Pleim and +C J. Young) +C 20 Mar 2008 Added a trap for undefined dry deposition velocities +C (e.g., NaN's). (T. Otte) +C 21 Mar 2008 Added heterogeneous reaction for HONO. It affects HONO, NO2 +C and HNO3 (G. Sarwar) +C 30 Apr 2008 Added five air toxic species to output. (W. Hutzell +C and T. Otte) +C August 2008 Applied a minimum value to ustg (0.001 m/s) to prevent +C negative rbg values in the bidi calculation (J. Pleim) +C 05 Oct 2009 Added condition that vegetation fraction must be +C greater than zero to be considered a land point. This +C works around intermittent inconsistencies in surface +C fields in some WRF data sets. (T. Otte) +C Dec 2009 Revised bidirectional NH3 flux calculations to use soil +C Gamma values read from gridded file. Bidi flux calcs +C based on comparisons with Lillington, NC corn data 2007 (J. Pleim) +C 30 Mar 2010 Modified to output the NH3 bidi stomtal, cuticle and soil component +C fluxes and chaged NH3 bidi variables used in estimating the compensation +C point double. (J. Bash) +C 16 Feb 2011 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C 20 May 2011 D.Schwede: add MOSAIC processing +C 14 Jul 2011 Replaced dw25 calculation with Hayduk and Laudie method. +C LeBas molar volumes are from the Schroeder additive method +C with the exception of HGIIGAS (modeled as HgCl2) which was +C obtained using the Tyn and Calus method. Also, ICL1 and ICL2 +C were removed. (D. Schwede) +C 27 Jul 2011 J.Bash: Parmaterized the mesophyll resistance as a function +C of solubility following Wesely 1989 Atmos Environ. +C 15 Aug 2011 Modified HONO calculation so that deposition velocity for NO2 +C that is output in DEPV file does not include the loss due to +C the heterogeneous reaction. This additional loss is now +C accounted for in vdiff.F (D. Schwede and G. Sarwar) +C 29 Aug 2011 Added NH3 bidirectional flux variables and modules and integrated +C NH3 bidi algorithms with MOSAIC algorithms. NH3 bidi routines now +C read in foratted EPIC output and maintain a soil NH4 budget and +C fluxes are calculated for individual land cover types. +C (J. Bash and D. Schwede) +C 22 Sep 2011 -- incorporated twoway model implementation +C -- removed non-use dluse array +C (David Wong) +C 26 Sep 2011 -- made the number of actual and dummy arguments the same in +C calling subroutine Init_ABFlux +C (David Wong) +C 7 Jun 2012 Allow read of C-staggered (UWINDC and VWINDC) wind and B-staggered +C (UWIND and VWIND) from MET_DOT_3D to maintain compatibility with +C current and previous versions of MCIP (J. Bash) +C 12 Sep 2012 Added code for NLCD40 land use classification (D. Schwede) +C------------------------------------------------------------------------------- + + USE HGRD_DEFN ! horizontal grid specifications + USE DEPVVARS + USE VGRD_DEFN ! to get VGTYP_GD + USE UTILIO_DEFN + USE SUBST_MODULES ! stenex + Use ABFlux_Mod ! bidi NH3 exchange routines + Use LSM_Mod ! land surface model variables needed for mosaic and bidi + Use Mosaic_Mod ! contains mosaic routines + Use Bidi_Mod, Only: lufrac +#ifdef twoway + USE twoway_data_module, only : num_land_cat +#endif + + IMPLICIT NONE +C Includes: + + INCLUDE SUBST_CONST ! constants + INCLUDE SUBST_FILES_ID ! file name parameters + INCLUDE SUBST_PE_COMM ! PE communication displacement and direction + +C Arguments: + + INTEGER, INTENT( IN ) :: jdate + INTEGER, INTENT( IN ) :: jtime + INTEGER, INTENT( IN ) :: dt( 3 ) ! model time step + LOGICAL, INTENT( IN ) :: abflux, sfc_hono, mosaic, fst + REAL, INTENT( IN ) :: cgridl1( :,:,: ) ! layer 1 concentrations + REAL, INTENT( OUT ) :: depvel_gas( :,:,: ) + REAL, INTENT( OUT ) :: pvd( :,:,: ) + REAL, INTENT( OUT ) :: cmp( :,:,: ) ! Bidi component fluxes JOB + +C Local Variables: + + REAL, PARAMETER :: a0 = 8.0 ! [dim'less] + INTEGER :: c + REAL :: cp_air ! specific heat of moist air + REAL :: ctemp2 ! temp2 [C] + + REAL, PARAMETER :: d3 = 1.38564e-2 ! [dim'less] + ! k*sqrt(rhoair/rhowater) from Slinn 78 + REAL, SAVE, ALLOCATABLE :: delta ( :,: ) + REAL :: dw + REAL :: dw25 ! diffusivity of water at 298.15 k + REAL, PARAMETER :: dwat = 0.2178 ! [cm^2/s] at 273.15K + LOGICAL :: effective ! true=compute effective Henry's Law const + INTEGER :: elapsedsec + INTEGER, SAVE :: endcol + INTEGER, SAVE :: endrow + INTEGER :: endcol_g + INTEGER :: endrow_g + REAL :: es_air + REAL :: es_grnd + LOGICAL, SAVE :: first_call = .TRUE. + INTEGER :: gxoff ! global origin offset from file + INTEGER :: gyoff ! global origin offset from file + REAL :: hcan + REAL :: heff ! effective Henry's Law constant + REAL :: heff_ap ! Henry's Law constant for leaf apoplast M/atm + REAL, EXTERNAL :: hlconst ! [M / atm] + REAL :: hplus + 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) + LOGICAL, SAVE :: ifq2 = .FALSE. ! Q2 in metcro2d? + INTEGER :: ifsnow ! 1=snow + LOGICAL, SAVE :: ifwr = .FALSE. ! canopy wetness from LSM? + REAL, PARAMETER :: kvis = 0.132 ! [cm^2 / s] at 273.15K + REAL :: kvisw ! kinematic viscosity of water [cm^2/s] + INTEGER :: l + REAL :: laicr ! cell leaf area index + INTEGER, SAVE :: logdev ! unit number for the log file + INTEGER, SAVE, ALLOCATABLE :: lstwetdate( :,: ) + INTEGER, SAVE, ALLOCATABLE :: lstwettime( :,: ) + REAL :: lv ! latent heat of vaporization + INTEGER :: n + CHARACTER( 16 ), PARAMETER :: pname = 'M3DRY' + REAL, PARAMETER :: pr = 0.709 ! [dim'less] + REAL :: q2p0cr ! cell 2.0 m water vapor mix ratio + REAL :: qss_air + REAL :: qss_grnd + INTEGER :: r + REAL :: rac + REAL :: rbc + REAL :: rbsulf + REAL :: rbw + REAL :: rci + REAL :: rcut + REAL, PARAMETER :: rcut0 = 3000.0 ! [s/m] + REAL, PARAMETER :: rcw0 = 125000.0 ! acc'd'g to Padro and + ! adapted from Slinn 78 + REAL, PARAMETER :: resist_min = 1.0e-30 ! minimum resistance + REAL, PARAMETER :: rg0 = 1000.0 ! [s/m] + REAL :: rgnd + REAL :: rgndc + REAL :: rgw ! resist for water-covered sfc + REAL, PARAMETER :: rgwet0 = 25000.0 ! [s/m] + REAL :: rh_air ! rel humidity (air) + REAL :: rh_grnd ! rel humidity (ground) + REAL :: rinc + REAL, PARAMETER :: rsndiff = 10.0 ! snow diffusivity fac + REAL :: rsnow + REAL, PARAMETER :: rsnow0 = 1000.0 + REAL :: rstom + REAL :: rsurf + REAL :: rwet ! wet sfc resist (cuticle or grnd) + REAL :: rwetsfc + REAL :: scw_pr_23 ! (scw/pr)**2/3 + INTEGER, SAVE :: strtcol + INTEGER, SAVE :: strtrow + INTEGER :: strtcol_g + INTEGER :: strtrow_g + 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 :: temp2p0cr ! cell 2.0-m temp + REAL :: tempgcr ! cell ground temp + REAL :: tw ! wet bulb temp. + REAL, PARAMETER :: twothirds = 2.0 / 3.0 + REAL :: ustarcr ! cell friction velocity + REAL :: vegcr ! cell veg coverage fraction + CHARACTER( 16 ) :: vname + REAL :: wrmax + REAL, SAVE :: xcent + REAL :: xm ! liquid water mass frac + CHARACTER( 96 ) :: xmsg = ' ' + CHARACTER( 16 ), SAVE :: vname_ra, vname_rc, vname_rn, vname_rs + REAL, SAVE :: ycent + +! REAL, SAVE, ALLOCATABLE :: dluse ( :,: ) + REAL, SAVE, ALLOCATABLE :: lon ( :,: ) +! REAL, SAVE, ALLOCATABLE :: lwmask ( :,: ) moved to LSM_MOD + REAL :: lai ( ncols,nrows ) ! leaf area index [area/area] + REAL :: prsfc ( ncols,nrows ) ! surface pressure [Pa] + REAL :: q2 ( ncols,nrows ) ! 2-m water vapor mix rat [kg/kg] + REAL :: ra ( ncols,nrows ) ! aerodynamic resistance [s/m] + REAL :: rc ( ncols,nrows ) ! convective rain [cm] + REAL :: rgrnd ( ncols,nrows ) ! SW radiation at ground [W/m2] + REAL :: rn ( ncols,nrows ) ! nonconvective rain [cm] + REAL :: rs ( ncols,nrows ) ! stomatal resistance [s/m] + REAL :: snocov ( ncols,nrows ) ! snow cover [1=yes, 0=no] + REAL :: temp2p0 ( ncols,nrows ) ! 2.0-m temperature [K] + REAL :: tempg ( ncols,nrows ) ! ground surface temperature [K] + REAL :: ustar ( ncols,nrows ) ! friction velocity [m/s] + REAL :: veg ( ncols,nrows ) ! vegetation coverage [fraction] + REAL :: wr ( ncols,nrows ) ! precip intercepted by canopy [m] + REAL :: wspd10 ( ncols,nrows ) ! 10-m wind speed [m/s] + REAL :: wstar ( ncols,nrows ) ! convective velocity scale [m/s] + REAL :: zruf ( ncols,nrows ) ! roughness length [m] + + INTEGER, SAVE :: n_spc_m3dry = ltotg ! from DEPVVARS module + + 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. + REAL, SAVE :: scc_pr_23( ltotg ) ! (SCC/PR)**2/3, fn of DIF0 + CHARACTER( 16 ) :: subname ( ltotg ) ! for subroutine HLCONST + + INTEGER :: SPC + +C------------------------------------------------------------------------------- +C For heterogenous hono on surfaces + REAL :: conc_no2 ! concentration of NO2 + REAL :: kno2 ! first order rate constant for the heterogenous reaction [1/s] + REAL, SAVE, ALLOCATABLE :: purb ( :,: ) ! urban percent [%] + REAL :: surf_bldg ! Surface area of bldgs to volume of air [-] + REAL :: surf_leaf ! Surface area of leaves to volume of air [-] + REAL, SAVE, ALLOCATABLE :: zf ( :,: ) ! layer height [m] + +C------------------------------------------------------------------------------- +C For Ammonia bi-directional flux + REAL :: sltyp ( ncols,nrows ) ! soil type + REAL :: wg ( ncols,nrows ) ! soil moisture in top 1 cm (vol frc) + REAL :: w2 ( ncols,nrows ) ! soil moisture in top 1 m (vol frc) + REAL :: cnh3 ! Layer 1 NH3 concentration from CGRID [ppm] + REAL :: tpvd ! temp pvd variable + REAL :: f_stom ! stomatal flux component + REAL :: f_cut ! cuticular flux component + REAL :: f_soil ! soil flux component + REAL :: f_emis ! Emission flux component + REAL :: f_dep ! Deposition flux component + REAL :: f_ag ! flux from agriculture + REAL :: f_nat ! flux from natural systems + REAL :: f_wat ! direct flux to surface water + REAL :: lnh3 ! loss part of ammonia flux + ! Note that lnh3 is stored in DEPVEL_GAS(nh3) for use in vdiff +C------------------------------------------------------------------------------- +C For Mosaic with Ammonia bi-directional flux + REAL, PARAMETER :: betah = 8.21 ! MM5 v3.7.4 uses Hogstrom + REAL, PARAMETER :: gamah = 11.6 + 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 :: soit2 ( ncols,nrows ) ! soil temperature in top m [K] + REAL :: qv ( ncols,nrows ) ! layer 1 water vapor mix rat [kg/kg] + REAL :: pres ( ncols,nrows ) ! layer 1 pressure [Pa] + REAL :: zh ( ncols,nrows ) ! mid-layer height above ground [m] + REAL :: moli ( ncols,nrows ) ! inverse of Monin-Obukhov length [m] + REAL :: ta ( ncols,nrows ) ! layer 1 temperature [K] + REAL :: uwind ( ncols+1,nrows+1 ) ! dot grid horizontal wind + REAL :: vwind ( ncols+1,nrows+1 ) ! dot grid cross wind + REAL :: v_cross + REAL :: u_cross + REAL :: rich + REAL :: rsj + REAL :: psihmm5 + REAL :: presmb ! pressure in mb + REAL :: qvs ! specific humidity layer 1 + REAL :: soit2cr + REAL :: theta + REAL :: thetav + REAL :: betap + REAL :: hu + REAL :: dthvdz + REAL :: radl + REAL :: radf + REAL :: f1 + REAL :: f2 + REAL :: f3 + REAL :: f4 + REAL :: ftot + REAL :: fshelt + REAL :: gs + REAL :: ga + REAL :: racj + REAL :: rcij + REAL :: raw + REAL :: rgwwat + REAL :: w2avail + REAL :: w2mxav + REAL :: wfccr + REAL :: zrufcr + REAL :: zol ! zh*moli + REAL :: zntol ! z0*moli + INTEGER :: soilcat + INTEGER :: j + INTEGER :: jday +! Integer, Save :: n_spc_m3dry = ltotg ! from DEPVVARS module + +C------------------------------------------------------------------------------- +C-- Chemical-Dependent Parameters (Original Source: Modified ADOM - Padro) +C +C at 298.15 K +C Species Dif0(cm2/s) Alphastar Reactivity -DKHOR [K] KH0 [M/atm] +C _______ ___________ _________ __________ _________ __________ +C 1 SO2 0.1089 ~ 1000. 8.00 3100.0 ~ 1.2e00 ~ +C 2 SULF -- -- -- -- -- +C 3 NO2 0.1361 ~ 1.00 8.00 2.00* 2500.0 ~ 1.2e-2 ~ +C 4 NO 0.1802 ~ 1 2.0+ 1500.0 ~ 1.9e-3 ~ +C 5 O3 0.1444 ~ 10.00 15.0 8@ 2700.0 ~ 1.2e-2 ~ +C 6 HNO3 0.1628 ~ 1E9 18.0 800* 8000** 8700.0 ~ 2.6e+6 ~ +C 7 H2O2 0.2402 ~ 1.00 12.0 30* 6600.0 ~ 9.7e+4 ~ +C 8 ACET ALD 0.1525 ~ 1 10.+ 5700.0 ~ 1.3e+1 ~ +C 9 HCHO 0.1877 ~ 1.00 10.+ 6400.0 ~ 7.0e+3 ~ +C 10 OP 0.1525 ~ 1 10.0+ 5200.0 ~ 3.1e+2 ~ +C 11 PAA 0.1220 ~ 1 20+ 5300.0 ~ 8.4e+2 ~ +C 12 ORA 0.1525 ~ 1 20+ 5700.0 ~ 3.7e+3 ~ +C 13 NH3 0.1978 ~ 1E5 10.0 4100.0 ~ 5.8e+1 ~ +C 14 PAN 0.0938 ~ 1 16.0~~ 5900.0 ~ 2.9e00 ~ +C 15 HONO 0.1525 ~ 1 20+ 4800.0 ~ 4.9e+1 ~ +C 16 CO 0.1807 ~ 1 5.0 1600.0 ~ 9.5e-4 ~ +C 17 METHANOL 0.1363 ~ 1.0 ~ 2.0 ~ 5200.0 ~ 2.2e+2 ~ +C -- CO2 0.1381 ~ 2400.0 ~ 3.4e-2 ~ +C 18 N2O5 0.0808 ^^ 5000.0** +C 19 NO3 0.1153 ^^ 5000.0** +C 20 GEN ALD 0.1525 ## 1.0 10.0## +C 21 CL2 0.1080 % 10.0 % +C 22 HOCL 0.1300 % 10.0 % +C 23 HCL 0.1510 % 8000.0 % +C 24 FMCL 0.1094 % 10.0 % +C 27 HG 0.1194 $ 0.1 $ +C 28 HGIIGAS 0.0976 $ 8000.0 $ +C 50 HEXAMETHYLENE DIISOCYANATE 10.0 <> +C 51 HYDRAZINE 20.0 <> +C 52 MALEIC ANHYDRIDE 10.0 <> +C 53 TOLUENE DIISOCYANATE 10.0 <> +C 54 TRIETHYLAMINE 10.0 <> +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------------------------------------------------------------------------------- + + 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) / 'SULFATE ', 0.0001, 0.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, 8.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, 30.0, 1.0, 28.0/ + 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.1, 49.0/ + 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/ + + IF ( first_call ) THEN + first_call = .FALSE. + logdev = init3() + + DO l = 1, n_spc_m3dry + IF ( dif0( l ) > 0.0 ) THEN + scc_pr_23( l ) = ( ( kvis / dif0( l ) ) / pr ) ** twothirds + ELSE + scc_pr_23( l ) = 0.0 + END IF + END DO + + 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 + +! ccccccccccccccccccccc enable backward compatiblity ccccccccccccccccccccc + + SPC = INDEX1( 'RA', NVARS3D, VNAME3D ) + IF (SPC .GT. 0) THEN + vname_ra = 'RA' + ELSE + vname_ra = 'RADYNI' + END IF + + SPC = INDEX1( 'RCA', NVARS3D, VNAME3D ) + IF (SPC .GT. 0) THEN + vname_rc = 'RCA' + ELSE + vname_rc = 'RC' + END IF + + SPC = INDEX1( 'RS', NVARS3D, VNAME3D ) + IF (SPC .GT. 0) THEN + vname_rs = 'RS' + ELSE + vname_rs = 'RSTOMI' + END IF + + SPC = INDEX1( 'RNA', NVARS3D, VNAME3D ) + IF (SPC .GT. 0) THEN + vname_rn = 'RNA' + ELSE + vname_rn = 'RN' + END IF + + xcent = real( xcent3d, 4 ) + ycent = real( ycent3d, 4 ) + + DO l = 1, nvars3d + IF ( vname3d( l ) .EQ. 'WR' ) THEN ! canopy wetness is in METCRO2D + ifwr = .TRUE. + WRITE( logdev,6501 ) + EXIT + END IF + END DO + + DO l = 1, nvars3d + IF ( vname3d( l ) .EQ. 'Q2' ) THEN ! 2-m mixing ratio is in METCRO2D + ifq2 = .TRUE. + WRITE( logdev,6503 ) + EXIT + END IF + END DO + + CALL subhfile ( grid_cro_2d, gxoff, gyoff, strtcol_g, endcol_g, strtrow_g, endrow_g ) + + CALL subhfile ( met_cro_2d, gxoff, gyoff, strtcol, endcol, strtrow, endrow ) + +! Write( logdev,* ) 'n_lufrac: ', n_lufrac + IF ( abflux .OR. mosaic ) THEN + IF ( .NOT. ALLOCATED ( lufrac ) ) THEN + ALLOCATE ( lufrac( n_lufrac,my_ncols,my_nrows ) ) + END IF + DO l = 1, n_lufrac + WRITE( vname,'( "LUFRAC_",I2.2 )' ) l + IF ( .NOT. interpx (grid_cro_2d, vname, pname, strtcol_g, endcol_g, + & strtrow_g, endrow_g, 1, 1, jdate, jtime, + & lufrac( l,:,: )) ) THEN + WRITE( xmsg,9001 ) vname, grid_cro_2d + GO TO 1001 + END IF + END DO + END IF + + IF ( abflux ) THEN + CALL Init_ABFlux( jdate, jtime ) + END IF + +C------------------------------------------------------------------------------- +C Read fields from grid_cro_2d. +C------------------------------------------------------------------------------- + + IF ( .NOT. ALLOCATED ( lon ) ) THEN + ALLOCATE ( lon ( my_ncols,my_nrows ) ) + END IF + + IF ( .NOT. ALLOCATED ( lwmask ) ) THEN + ALLOCATE ( lwmask ( my_ncols,my_nrows ) ) + END IF + +! IF ( .NOT. ALLOCATED ( dluse ) ) THEN +! ALLOCATE ( dluse ( my_ncols,my_nrows ) ) +! END IF + + vname = 'LON' + IF ( .NOT. interpx (grid_cro_2d, vname, pname, strtcol_g, endcol_g, + & strtrow_g, endrow_g, 1, 1, jdate, jtime, lon) ) THEN + WRITE( xmsg,9001 ) vname, grid_cro_2d + GO TO 1001 + END IF + + vname = 'LWMASK' + IF ( .NOT. interpx (grid_cro_2d, vname, pname, strtcol_g, endcol_g, + & strtrow_g, endrow_g, 1, 1, jdate, jtime, lwmask) ) THEN + WRITE( xmsg,9001 ) vname, grid_cro_2d + GO TO 1001 + END IF + +! vname = 'DLUSE' +! IF ( .NOT. interpx (grid_cro_2d, vname, pname, strtcol, endcol, +! & strtrow, endrow, 1, 1, jdate, jtime, dluse) ) THEN +! WRITE( xmsg,9001 ) vname, grid_cro_2d +! GO TO 1001 +! END IF + + IF ( .NOT. ALLOCATED ( delta ) ) THEN + ALLOCATE ( delta( my_ncols,my_nrows ) ) + delta( :,: ) = 0.0 + END IF + + IF ( .NOT. ALLOCATED ( lstwetdate ) .AND. .NOT. ifwr ) THEN + ALLOCATE ( lstwetdate( my_ncols,my_nrows ) ) + lstwetdate( :,: ) = 0 + END IF + + IF ( .NOT. ALLOCATED ( lstwettime ) .AND. .NOT. ifwr ) THEN + ALLOCATE ( lstwettime( my_ncols,my_nrows ) ) + lstwettime( :,: ) = 0 + END IF + + IF ( sfc_hono ) THEN + IF ( .NOT. ALLOCATED ( zf ) ) THEN + ALLOCATE ( zf( my_ncols,my_nrows ) ) + END IF + IF ( .NOT. ALLOCATED ( purb ) ) THEN + ALLOCATE ( purb( my_ncols,my_nrows ) ) + END IF + vname = 'PURB' + IF ( .NOT. interpx (grid_cro_2d, vname, pname, strtcol_g, endcol_g, + & strtrow_g, endrow_g, 1, 1, jdate, jtime, purb) ) THEN + WRITE( xmsg,9001 ) vname, grid_cro_2d + GO TO 1001 + END IF + END IF ! src_hono + + END IF ! first_call + +C------------------------------------------------------------------------------- +C Read fields from met_cro_2d. +C------------------------------------------------------------------------------- + + vname = 'LAI' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, lai) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'PRSFC' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, prsfc) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + IF ( ifq2 ) THEN + vname = 'Q2' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, q2) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + END IF + + IF ( .NOT. interpx (met_cro_2d, vname_ra, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, ra) ) THEN + WRITE( xmsg,9001 ) vname_ra, met_cro_2d + GO TO 1001 + END IF + IF ( vname_ra .EQ. 'RADYNI' ) THEN + DO r = 1, my_nrows + DO c = 1, my_ncols + ra( c,r ) = 1.0 / MAX( ra( c,r ), resist_min ) + END DO + END DO + END IF + + IF ( .NOT. interpx (met_cro_2d, vname_rc, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, rc) ) THEN + WRITE( xmsg,9001 ) vname_rc, met_cro_2d + GO TO 1001 + END IF + + vname = 'RGRND' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, rgrnd) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + IF ( .NOT. interpx (met_cro_2d, vname_rn, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, rn) ) THEN + WRITE( xmsg,9001 ) vname_rn, met_cro_2d + GO TO 1001 + END IF + + IF ( .NOT. interpx (met_cro_2d, vname_rs, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, rs) ) THEN + WRITE( xmsg,9001 ) vname_rs, met_cro_2d + GO TO 1001 + END IF + IF ( vname_rs .EQ. 'RSTOMI' ) THEN + DO r = 1, my_nrows + DO c = 1, my_ncols + rs( c,r ) = 1.0 / MAX( rs( c,r ), resist_min ) + END DO + END DO + END IF + + vname = 'SNOCOV' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, snocov) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'TEMP2' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, temp2p0) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'TEMPG' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, tempg) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'USTAR' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, ustar) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'VEG' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, veg) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + IF ( ifwr ) THEN + vname = 'WR' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, wr) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + END IF + + vname = 'WSPD10' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, wspd10) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'WSTAR' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, wstar) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'ZRUF' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, zruf) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'SLTYP' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, sltyp) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + +! Write(logdev,*) 'Before read metcro2d variables' + IF ( abflux .OR. mosaic ) THEN + vname = 'SOIM1' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, wg) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'SOIM2' + IF ( .NOT. interpx (met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, w2) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'MOLI' + IF ( .NOT. interpx (met_crO_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, moli) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + vname = 'SOIT2' + IF ( .NOT. interpx( met_cro_2d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, soit2) ) THEN + WRITE( XMSG,9001 ) vname, met_cro_2d + GO TO 1001 + END IF + + END IF +C------------------------------------------------------------------------------- +C Read fields from met_cro_3d. +C------------------------------------------------------------------------------- + + IF ( .NOT. ifq2 ) THEN ! Q2 not in METCRO2D; substitute layer-1 QV + vname = 'QV' + IF ( .NOT. interpx (met_cro_3d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, q2) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_3d + GO TO 1001 + END IF + END IF + + IF ( sfc_hono ) THEN + vname = 'ZF' + IF ( .NOT. interpx ( met_cro_3d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, zf) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_3d + GO TO 1001 + END IF + END IF + +! Write(logdev,*) 'Before read metcro3d variables' + IF ( abflux .OR. mosaic ) THEN + vname = 'ZH' + IF ( .NOT. interpx ( met_cro_3d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, zh) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_3d + + GO TO 1001 + END IF + + vname = 'QV' + IF ( .NOT. interpx (met_cro_3d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, qv) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_3d + + GO TO 1001 + END IF + + vname = 'TA' + IF ( .NOT. interpx (met_cro_3d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, ta) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_3d + + GO TO 1001 + END IF + + vname = 'PRES' + IF ( .NOT. interpx (met_cro_3d, vname, pname, strtcol, endcol, + & strtrow, endrow, 1, 1, jdate, jtime, pres) ) THEN + WRITE( xmsg,9001 ) vname, met_cro_3d + + GO TO 1001 + END IF + +! Try to read the U and V wind components on the C-staggered grid. If this fails, +! try reading them off of the B-staggered grid for backwards compatibility with MCIP + vname = 'UWINDC' + IF ( .NOT. interpx (met_dot_3d, vname, pname, strtcol, endcol+1, + & strtrow, endrow+1, 1, 1, jdate, jtime, uwind) ) THEN + vname = 'UWIND' + IF ( .NOT. interpx (met_dot_3d, vname, pname, strtcol, endcol+1, + & strtrow, endrow+1, 1, 1, jdate, jtime, uwind) ) THEN + WRITE( xmsg,9001 ) vname, met_dot_3d + + GO TO 1001 + END IF + END IF + vname = 'VWINDC' + IF ( .NOT. interpx (met_dot_3d, vname, pname, strtcol, endcol+1, + & strtrow, endrow+1, 1, 1, jdate, jtime, vwind) ) THEN + vname = 'VWIND' + IF ( .NOT. interpx (met_dot_3d, vname, pname, strtcol, endcol+1, + & strtrow, endrow+1, 1, 1, jdate, jtime, vwind) ) THEN + WRITE( xmsg,9001 ) vname, met_dot_3d + + GO TO 1001 + END IF + END IF + END IF + +C------------------------------------------------------------------------------- +C Loop over grid cells and calculate dry deposition. +C------------------------------------------------------------------------------- + + effective = .TRUE. + + depvel_gas( :,:,: ) = 0.0 ! initialize for this time period + pvd ( :,:,: ) = 0.0 ! " " " " " + cmp ( :,:,: ) = 0.0 ! " " " " " JOB + +! Write(logdev,*) 'Before devel_gasj' + IF ( mosaic .OR. abflux ) THEN + + depvel_gasj( :,:,:,: ) = 0.0 ! " " " " " + ustarj ( :,:,: ) = 0.0 ! " " " " " + IF ( fst ) then + rcanj ( :,:,:,: ) = 1.0e30 ! " " " " " + vd_fst_gasj( :,:,:,: ) = 0.0 ! " " " " " + END IF + CALL SUBST_COMM ( UWIND, DSPL_N0_E1_S0_W0, DRCN_E ) + CALL SUBST_COMM ( VWIND, DSPL_N1_E0_S0_W0, DRCN_N ) + END IF + + jday = jdate - 1000 * ( jdate/1000 ) + + DO r = 1, my_nrows + DO c = 1, my_ncols + + laicr = lai ( c,r ) + q2p0cr = q2 ( c,r ) + temp2p0cr = temp2p0( c,r ) + tempgcr = tempg ( c,r ) + ustarcr = ustar ( c,r ) + vegcr = veg ( c,r ) + soit2cr = soit2 ( c,r ) + zrufcr = zruf ( c,r ) + soilcat = NINT( sltyp( c,r ) ) + ifsnow = MAX( 0, NINT( snocov( c,r ) ) ) + + IF ( abflux .OR. mosaic ) THEN + DO j = 1, n_lufrac + lufraccr( j ) = lufrac( j,c,r ) + END DO + + IF ( ( NINT( lwmask( c,r ) ) .NE. 0 ) .AND. ( vegcr .GT. 0.0 ) ) THEN ! land + + CALL Calc_Lai( jday, jtime, soit2cr, lufraccr, laicr, zrufcr, + & laijcr, z0jcr, vegjcr, logdev, c, r ) + DO j = 1, n_lufrac + laij(j,c,r) = laijcr(j) + z0j(j,c,r) = z0jcr(j) + vegj(j,c,r) = vegjcr( j ) + END DO + + ELSE + DO j = 1, n_lufrac + laij(j,c,r) = 0.0 + z0j(j,c,r) = 0.000001 + vegj( j,c,r ) = 0.0 + END DO + END IF + + END IF ! mosaic loop + +! Calculate the relative humidity of air and ground. + + IF ( temp2p0cr .LE. stdtemp ) THEN + es_air = vp0 * EXP( 22.514 - (6.15e3 / temp2p0cr) ) + ELSE + es_air = vp0 * EXP( svp2 * (temp2p0cr - stdtemp) / + & (temp2p0cr - svp3) ) + END IF + + qss_air = es_air * 0.622 / (prsfc( c,r ) - es_air) + rh_air = 100.0 * q2p0cr / qss_air + rh_air = MIN( 100.0, rh_air ) + + IF ( tempgcr .LE. stdtemp ) THEN + es_grnd = vp0 * EXP( 22.514 - (6.15e3 / tempgcr) ) + ELSE + es_grnd = vp0 * EXP( svp2 * (tempgcr - stdtemp) / + & (tempgcr - svp3) ) + END IF + + qss_grnd = es_grnd * 0.622 / (prsfc( c,r ) - es_grnd) + rh_grnd = 100.0 * q2p0cr / qss_grnd + rh_grnd = MIN( 100.0, rh_grnd ) + +! Write(logdev,*) 'Before OM simularity vars' + IF ( mosaic .OR. abflux ) THEN + zol = zh(c,r) * moli(c,r) + presmb = pres(c,r)/100.0 ! convert layer 1 preesure from Pa to mb + qvs = qv(c,r)/(1.0 + qv(c,r)) + theta = ta(c,r) * (1000.0/presmb)**(287.04/1004.e0) + thetav = theta*(1.0+0.61*qv(c,r)) + + IF ( ( NINT(lwmask( c,r )) .NE. 0 ) .AND. ( vegcr .GT. 0.0 ) ) THEN ! land +! raj is estimated using stability correction based on MOL for grid cell for now + DO j = 1, n_lufrac + + U_cross = 0.25 * (UWIND(C,R) + UWIND(C+1,R) + + & UWIND(C,R+1) + UWIND(C+1,R+1)) + V_cross = 0.25 * (VWIND(C,R) + VWIND(C+1,R) + + & VWIND(C,R+1) + VWIND(C+1,R+1)) + + IF ( lufraccr( j ) .GT. 0.0 ) THEN + ustarj( j,c,r ) = ustarcr * SQRT( LOG( zh( c,r ) / Zrufcr ) + & / LOG( zh( c,r ) / z0j( j,c,r ) ) ) + zntol = z0j(j,c,r) * moli(c,r) + +! ra calculation depends on met model used + SELECT CASE( vgtyp_gd ) + CASE( 7 ) +! Write(logdev,*) 'Before call ra_wrf' + CALL ra_wrf(moli(c,r),zol,zntol,zh(c,r),ustarj(j,c,r),z0j(j,c,r),j,c,r) + CASE( 2 ) + IF ( Land_Scheme .EQ. 'USGS24' ) THEN + SELECT CASE(j) + CASE(16) ! water + wfccr = -999. + CASE DEFAULT ! Land + wfccr = wfc(soilcat) + END SELECT + END IF + IF ( Land_Scheme .EQ. 'NLCD50' ) THEN + SELECT CASE(j) + CASE(1,31,48) ! water + wfccr = -999. + CASE DEFAULT ! Land + wfccr = wfc(soilcat) + END SELECT + END IF + IF ( Land_Scheme .EQ. 'NLCD40' ) THEN + SELECT CASE(j) + CASE(17,21) ! water + wfccr = -999. + CASE DEFAULT ! Land + wfccr = wfc(soilcat) + END SELECT + END IF + IF ( Land_Scheme .EQ. 'MODIS' ) THEN + SELECT CASE(j) + CASE(17) ! water + wfccr = -999. + CASE DEFAULT ! Land + wfccr = wfc(soilcat) + END SELECT + END IF +! Write(logdev,*) 'Before call ra_mm5' + CALL ra_mm5( wspd10(c,r),u_cross,v_cross,theta,thetav,tempgcr,qv(c,r),qss_grnd, + & snocov(c,r),prsfc(c,r),lwmask(c,r), + & wg(c,r),wfccr,zh(c,r),z0j(j,c,r),ustarj(j,c,r),raj(j,c,r),rich, + & psihmm5,betap,hu,dthvdz ) + CASE DEFAULT + xmsg = 'met file format not recognized for mosaic' + CALL m3exit( pname, jdate, jtime, xmsg, xstat1 ) + END SELECT +! rbcj(j) = 5.0 / ustarj( j,c,r ) * scc_pr_23( l ) + END IF ! lufraccr > 0 + END DO + ELSE ! water - no need to do mosaic + DO j = 1, n_lufrac + ustarj (j,c,r ) = ustarcr + raj (j,c,r ) = ra(c,r) + z0j (j,c,r ) = zrufcr +! rbcj(j) = 5.0 / ustarj( j,c,r ) * scc_pr_23( l ) + END DO + END IF ! land or water + END IF + + IF ( ( NINT(lwmask( c,r )) .NE. 0 ) .AND. ( vegcr .GT. 0.0 ) ) THEN ! land + + IF ( .NOT. ifwr ) THEN ! approx canopy wetness - dew from Wesely + + ! canopy is wet if > trace precip. or moist with light winds + + IF ( ( rn( c,r ) + rc( c,r ) .GT. 0.025 ) .OR. + & ( (0.6 + wspd10( c,r ))*(100.0-rh_grnd) .LE. 19.0 ) ) THEN + + delta( c,r ) = 1.0 + lstwetdate( c,r ) = jdate + lstwettime( c,r ) = jtime + + ELSE + + IF ( rgrnd( c,r ) .GT. 5.0 ) THEN ! day (if at night, persist delta) + + ! Determine if canopy was recently wet. + + IF ( ( lstwetdate( c,r ) .GT. 0 ) .AND. + & ( lstwettime( c,r ) .GT. 0 ) ) THEN ! canopy recently wet + + elapsedsec = secsdiff ( lstwetdate( c,r ), + & lstwettime( c,r ), + & jdate, jtime ) + + IF ( ( elapsedsec .GT. 0 ) .AND. ! assume canopy stays + & ( elapsedsec .LE. 7200 ) ) THEN ! wet for 2 h + delta( c,r ) = 1.0 + ELSE IF ( ( elapsedsec .GT. 7200 ) .AND. ! ramp down DELTA + & ( elapsedsec .LT. 10800 ) ) THEN ! between 2 & 3 h + delta( c,r ) = ( 10800.0 - FLOAT( elapsedsec ) ) / 3600.0 + ELSE + delta( c,r ) = 0.0 + lstwetdate( c,r ) = 0 + lstwettime( c,r ) = 0 + END IF + + END IF + + END IF + + END IF + +! Write(logdev,*) 'Before load deltaj' + IF ( mosaic .OR. abflux ) THEN + DO j = 1, n_lufrac + deltaj(j,c,r) = delta(c,r) + END DO + END IF + + ELSE ! Already have canopy wetness explicitly from met model + + wrmax = 0.2e-3 * vegcr * laicr ! [m] + IF ( wr( c,r ) .LE. 0.0 ) THEN + delta( c,r ) = 0.0 + ELSE + delta( c,r ) = wr( c,r ) / wrmax ! refer to SiB model + delta( c,r ) = MIN( delta( c,r ), 1.0 ) + END IF + +! Write(logdev,*) 'Before deltaj calc' + IF ( mosaic .OR. abflux ) THEN + DO j = 1, n_lufrac + wrmax = 0.2e-3 * vegj(j,c,r) * laij(j,c,r) ! [m] changed to vegj for mosaic JOB + IF ( ( wr( c,r ) .LE. 0.0 ) .or. ( laij(j,c,r) .LE. 0.0 ) ) THEN + deltaj( j,c,r ) = 0.0 + ELSE + deltaj( j,c,r ) = wr( c,r ) / wrmax ! refer to SiB model + deltaj( j,c,r ) = MIN( deltaj( j,c,r ), 1.0 ) + END IF + END DO + END IF + + END IF ! canopy wetness + + ! Assign a pH for rain water based on longitude if US simulation. + ! Otherwise use default pH. Use pH value in HPLUS calculation. + + IF ( ( ycent .GE. 30.0 ) .AND. ( ycent .LE. 45.0 ) .AND. + & ( xcent .GE. -120.0 ) .AND. ( xcent .LE. -70.0 ) ) THEN + IF ( lon( c,r ) .GT. -100.0 ) THEN + hplus = hplus_east + ELSE + hplus = hplus_west + END IF + ELSE + hplus = hplus_def + END IF + + ELSE ! water + ! Calculate the water surface film temperature: wet bulb temperature. + ! Wet bulb temperature based on eqn in Fritschen and Gay (1979). + + ctemp2 = temp2p0cr - stdtemp + lv = lv0 - dlvdt * ctemp2 + cp_air = 1004.67 * ( 1.0 + 0.84 * q2p0cr ) ! [J/kg/K] + tw = ( ( 4.71e4 * cp_air / lv ) - 0.870 ) + stdtemp ! [K] + + END IF ! land or water + + ! Loop over species to calculate dry deposition velocities. + + n = 0 + ddloop: DO l = 1, n_spc_m3dry + + IF ( .NOT. use_depspc( l ) ) CYCLE ddloop + + n = n + 1 + + IF ( TRIM( depspc( l ) ) .EQ. 'SULF' ) THEN ! Sulfate (SULF) + + ! Sulfate calculation follows Wesely (1985), Eqn. 11. + + rbsulf = 1.0 / ( 0.002*(ustarcr**2 + 0.24*wstar( c,r )**2 ) / + & ustarcr ) + depvel_gas( n,c,r ) = 1.0 / ( ra( c,r ) + rbsulf ) + +! Write(logdev,*) 'Before calc rbsulf and depvel_gasj' + IF ( mosaic ) THEN + DO j = 1, n_lufrac + IF ( lufraccr( j ) .GT. 0.0 ) THEN + rbsulf = 1.0 / ( 0.002 * ( ustarj( j,c,r )**2 + & + 0.24 * wstar( c,r )**2 ) / ustarj( j,c,r ) ) + depvel_gasj( j,l,c,r ) = 1.0 / ( raj( j,c,r ) + rbsulf ) + END IF + END DO + END IF ! mosaic + + ELSE + + IF ( ( NINT(lwmask( c,r )) .EQ. 0 ) .OR. ( vegcr .EQ. 0.0 ) ) THEN ! water + + ! Use CMAQ function for calculating the effective Henry's Law + ! constant. Note that original M3DRY wants inverse, non- + ! dimensional Henry's Law (caq/cg). Water pH is different + ! than rain, and we need to use the water temperature. + + heff = hlconst( subname( l ), tw, effective, hplus_h2o ) + + ! Make Henry's Law constant non-dimensional. + + heff = heff * 0.08205 * tw + + ! from Hayduk and Laudie + dw25 = 13.26e-5 / ( 0.8904**1.14 * lebas( l )**0.589 ) + kvisw = 0.017 * EXP( -0.025 * ( tw - stdtemp ) ) + dw = dw25 * ( tw * rt25inK ) * ( 0.009025 / kvisw ) + scw_pr_23 = ( ( kvisw / dw ) / pr ) ** twothirds + rgw = scw_pr_23 / ( heff * d3 * ustarcr ) + rsurf = rgw +! Write(logdev,*) 'Before call rsurfj' + IF ( mosaic ) THEN + DO j = 1, n_lufrac + IF ( lufraccr( j ) .GT. 0.0 ) THEN + rsurfj( j,l,c,r ) = rsurf + END IF + END DO + END IF ! mosaic + + ELSE ! land + + ! Use CMAQ function for calculating the effective Henry's Law + ! constant. Note that original M3DRY wants inverse, + ! non-dimensional Henry's Law (caq/cg). + + heff = hlconst( subname( l ), temp2p0cr, effective, hplus ) + + ! Make Henry's Law constant non-dimensional. + + heff = heff * 0.08205 * temp2p0cr + + ! Wet surface resistance. (Note DELTA = CWC in ADOM lingo.) + ! This now applies to cuticle and ground. + + IF ( TRIM( depspc( l ) ) .NE. 'O3' ) THEN + rwet = rcw0 / heff ! wet cuticle + ELSE + ! Set RCW/LAI = 200 s/m on basis of Keysburg exp for O3 + rwet = 1250.0 ! s/m + END IF + + rgw = rgwet0 / heff ! wet ground + + ! Dry snow resistance. + + rsnow = rsnow0 * a0 / ar( l ) + + ! If the surface is cold and wet, use dry snow. + + IF ( tempgcr .LT. stdtemp ) THEN + rwetsfc = rsnow + ELSE + rwetsfc = rwet + END IF + + ! Dry cuticle resistance. + + IF ( TRIM( depspc( l ) ) .NE. 'NH3' ) THEN + rcut = rcut0 * a0 / ar( l ) + ELSE + rcut = 4000.0 * EXP( -0.054 * rh_air ) + END IF + + ! Dry ground resistance. (revised according to Erisman) + + hcan = zruf( c,r ) * 10.0 + rinc = 14.0 * laicr * hcan / ustarcr + rgnd = rg0 * a0 / ar( l ) + rgndc = 1.0 / ( ( 1.0 - delta( c,r ) ) / rgnd + delta( c,r ) / rgw ) + & + rinc ! Add in-canopy part +! Write(logdev,*) 'Before call rdndcj' + IF ( mosaic .OR. abflux ) THEN + DO j = 1, n_lufrac + IF (lufraccr( j ) .GT. 0.0 ) THEN + hcanj ( j ) = Z0j( j,c,r ) * 10.0 + rincj( j,c,r ) = 14.0 * laij( j,c,r ) * hcanj( j ) + & / ustarj( j,c,r ) + rgndcj( j,c,r ) = 1.0 / ( ( 1.0 - deltaj( j,c,r ) ) + & / rgnd + deltaj( j,c,r ) / rgw ) + & + rincj( j,c,r ) ! Add in-canopy part + END IF + END DO + END IF + + ! Determine the snow liquid water mass fraction (0.0 to 0.5). + + xm = 0.02 * ( temp2p0cr - ( stdtemp - 1.0 ) )**2 + xm = MIN (xm, 0.5) + xm = MAX (xm, 0.0) + IF ( temp2p0cr .LT. ( stdtemp - 1.0 ) ) xm = 0.0 + + ! Bulk stomatal resistance; include mesophyll resistance. + + heff_ap = hlconst( subname( l ), temp2p0cr, effective, hplus_ap ) + + rstom = rs( c,r ) * dwat / dif0( l ) + & + 1.0 / ( heff_ap / 3000.0 + 100.0 * meso( l ) ) / laicr + +! Recalculate stomal resistance for each land use category +! Write(logdev,*) 'Before calc rstomj' + IF ( mosaic .OR. abflux ) THEN + DO j = 1, n_lufraC + IF ( lufraccr( j ) .GT. 0.0 ) THEN + IF ( (Land_scheme .EQ. 'USGS24' .AND. j .NE. 16) .OR. + & (Land_scheme .EQ. 'NLCD50' .AND. j .NE. 1 .AND. + & j .NE. 31 .AND. j .NE. 48) .OR. + & (Land_scheme .EQ. 'NLCD40' .AND. j .NE. 17 .AND. + & j .NE. 21) .OR. + & (Land_scheme .EQ. 'MODIS' .AND. j .NE. 17 )) THEN + IF ( laij( j,c,r ) .LT. 0.00001 ) THEN + rstomj( j,l,c,r ) = rsmax + ELSE +!-RADIATION + IF ( rsmin_p( j ) .GT. 130.0 ) THEN + radl = 30.0 ! W/M2 + ELSE + radl = 100.0 ! W/M2 + END IF + radf = 1.1 * rgrnd( c,r ) / ( radl * laij( j,c,r ) ) ! NP89 - EQN34 + f1 = ( rsmin_p( j ) / rsmax + radf ) / ( 1.0 + radf ) + +!-SOIL MOISTURE + w2avail = w2( c,r ) - wwlt( soilcat ) + w2mxav = wfc( soilcat ) - wwlt( soilcat ) + f2 = 1.0 / ( 1.0 + EXP( -5.0 * ( w2avail / w2mxav - + & ( w2mxav / 3.0 + wwlt( soilcat ) ) ) ) ) ! according JP, 9/94 + +!-AIR TEMP +!... according to Avissar (1985) and AX 7/95 + + IF ( ta( c,r ) .LE. 302.15 ) THEN + f4 = 1.0 / ( 1.0 + EXP( -0.41 * (ta( c,r ) - 282.05 ) ) ) + ELSE + f4 = 1.0 / ( 1.0 + EXP( 0.5 * (ta( c,r ) - 314.0 ) ) ) + END IF + + ftot = laij( j,c,r ) * f1 * f2 * f4 + ftot = MAX( ftot,ftmin ) + fshelt = 1.0 ! go back to NP89 + gs = ftot / ( rsmin_p( j ) * fshelt ) + raw = raj( j,c,r ) + 4.503 / ustarj( j,c,r ) + ga = 1.0 / raw + +!-- Compute humidity effect according to RH at leaf surf + f3 = 0.5 * ( gs - ga + SQRT( ga * ga + ga * gs + & * ( 4.0 * qv( c,r ) / qss_grnd - 2.0 ) + gs * gs ) ) / gs + f3 = MIN ( MAX( f3, f3min ), 1.0 ) + rsj = 1.0 / ( gs * f3 ) + rstomj( j,l,c,r ) = rsj * dwat / dif0( l ) + & + 1.0 / ( heff_ap / 3000.0 + 100.0 * meso( l ) ) / laij( j,c,r ) + END IF + END IF + END IF + END DO ! n_lufrac + END IF ! mosaic + + ! Bulk surface resistance. + + rci = vegcr + & * ( 1.0/rstom + (1.0-delta( c,r ) ) * laicr / rcut + & + ( delta( c,r ) * laicr / rwetsfc ) + 1.0 / rgndc ) + & + real( 1-ifsnow ) * ( (1.0 - vegcr) * ( (1.0-delta( c,r ) ) / + & rgnd + delta( c,r ) / rgw ) ) + & + real( ifsnow ) * ( (1.0 - xm) / rsnow + xm / (rsndiff + rgw) ) + + rsurf = 1.0 / rci + +! Write(logdev,*) 'Before call rsurfj' + IF ( mosaic ) THEN + DO j = 1, n_lufrac + + IF ( lufraccr( j ) .GT. 0.0 ) THEN +! IF ( j .eq. iwat ) THEN ! water -- code duplicate from above as it + ! would only have been calculated above if it is a water cell + IF ( ( Land_scheme .EQ. 'USGS24' .AND. j .EQ. 16 ) .OR. + & ( Land_scheme .EQ. 'NLCD50' .AND. j .EQ. 1 .OR. + & j .EQ. 31 .OR. j .EQ. 48 ) .OR. + & ( Land_scheme .EQ. 'NLCD40' .AND. j .EQ. 17 .OR. + & j .EQ. 21) .OR. + & ( Land_scheme .EQ. 'MODIS' .AND. j .EQ. 17 ) ) THEN ! water + ctemp2 = temp2p0cr - stdtemp + lv = lv0 - dlvdt * ctemp2 + cp_air = 1004.67 * ( 1.0 + 0.84 * q2p0cr ) ! [J/kg/K] + tw = ( ( 4.71E4 * cp_air / lv ) - 0.870 ) + stdtemp ! [K] + IF ( TRIM( depspc( l ) ) .EQ. 'HG' ) THEN ! elemental mercury gas + rsurfj( j,l,c,r ) = 1.0E30 + ELSE + heff = hlconst( subname( l ), tw, effective, hplus_h2o ) + heff = heff * 0.08205 * tw +! from Hayduk and Laudie + dw25 = 13.26e-5 / ( 0.8904**1.14 * lebas( l )**0.589 ) + kvisw = 0.017 * EXP( -0.025 * ( tw - stdtemp ) ) + dw = dw25 * ( tw * rt25inK ) * ( 0.009025 / kvisw ) + scw_pr_23 = ( ( kvisw / dw ) / pr ) ** twothirds + rgwwat = 1.0 / ( heff * d3 * ustarj( j,c,r ) ) + rsurfj( j,l,c,r ) = rgwwat + END IF + + ELSE ! land category + rcij = vegj( j,c,r ) + & * ( 1.0 / rstomj( j,l,c,r ) + ( 1.0 - deltaj( j,c,r ) ) + & * laij( j,c,r ) / rcut + & + ( deltaj( j,c,r ) * laij( j,c,r ) / rwetsfc ) + & + 1.0 / rgndcj( j,c,r ) ) + & + real( 1 - ifsnow ) * ( ( 1.0 - vegj( j,c,r )) + & * ( ( 1.0 - deltaj( j,c,r ) ) / rgnd + & + deltaj( j,c,r ) / rgw ) ) + & + real( ifsnow ) * ( ( 1.0 - xm) / rsnow + xm / ( rsndiff + rgw ) ) + rsurfj(j,l,c,r) = 1.0 / rcij + END IF + END IF + END DO + END IF ! mosaic + + END IF ! land or water cell + + ! Compute dry deposition velocity. + + rbc = 5.0 / ustarcr * scc_pr_23( l ) + rac = ra( c,r ) + rbc + + depvel_gas( n,c,r ) = 1.0 / ( rsurf + rac ) + + IF ( mosaic .OR. abflux ) THEN ! initialize col/row boundary layer resistance + DO j = 1, n_lufrac + IF ( lufraccr( j ) .GT. 0.0 ) THEN + rbcj(j) = 5.0 / ustarj( j,c,r ) * scc_pr_23( l ) + END IF + END DO + END IF ! mosaic + + IF ( mosaic ) THEN +! Write(logdev,*) 'Before calc devel_gasj' + DO j = 1, n_lufrac + IF ( lufraccr( j ) .GT. 0.0 ) THEN + +! rbcj(j) = 5.0 / ustarj( j,c,r ) * scc_pr_23( l ) + racj = raj( j,c,r ) + rbcj(j) + depvel_gasj( j,l,c,r) = 1.0 / ( rsurfj( j,l,c,r ) + racj ) + IF ( depvel_gasj( j,l,c,r ) .LT. 0.0 .OR. + & depvel_gasj( j,l,c,r ) .NE. depvel_gasj( j,l,c,r ) ) THEN + WRITE( logdev,9033 ) c, r, j, TRIM( subname( l ) ), + & depvel_gasj( j,l,c,r ), laij( j,c,r ), + & z0j( j,c,r ), ustarj( j,c,r ), rgndcj( j,c,r ), + & raj( j,c,r ), rbcj(j), rsurfj( j,l,c,r ), + & rstomj( j,l,c,r ), rcut, rwetsfc, rgnd, rgw, + & deltaj( j,c,r ), vegj(j,c,r), xm, rsndiff, ifsnow + xmsg = 'ABORT' + CALL m3exit( pname, jdate, jtime, xmsg, xstat1 ) + END IF + IF ( fst ) THEN + IF ( (( Land_scheme .EQ. 'USGS24' .AND. j .EQ. 16 ) .OR. + & ( Land_scheme .EQ. 'NLCD50' .AND. j .EQ. 1 .OR. + & j .EQ. 31 .OR. j .EQ. 48 ) .OR. + & ( Land_scheme .EQ. 'NLCD40' .AND. j .EQ. 17 .OR. + & j .EQ. 21) .OR. + & ( Land_scheme .EQ. 'MODIS' .AND. j .EQ. 17 ) ) .OR. + & ( lwmask( c,r ) .EQ. 0.0 ) ) THEN ! water + vd_fst_gasj( j,l,c,r) = 0.0 + ELSE + vd_fst_gasj(j,l,c,r) = (1.0/(racj+rsurfj(j,l,c,r)))*(rsurfj(j,l,c,r)/rstomj(j,l,c,r)) + + IF ( vd_fst_gasj( j,l,c,r ) > depvel_gasj( j,l,c,r ) ) THEN + +#ifdef Verbose + write( logdev,* ) 'vd_fst > vd_mos at ', jdate, jtime + write( logdev,* ) 'vd_fst, vd_mos: ', vd_fst_gasj( j,l,c,r ), + & depvel_gasj( j,l,c,r ) + write( logdev,* ) ' ' + WRITE( logdev,9034 ) c, r, j, TRIM( subname( l ) ), + & vd_fst_gasj( j,l,c,r ),racj,rcanj(j,l,c,r),rstomj(j,l,c,r) +#endif + vd_fst_gasj( j,l,c,r ) = depvel_gasj( j,l,c,r ) ! best we can do with limitations of methid + END IF + END IF + END IF ! fst + END IF + END DO + END IF ! mosaic +C-------------------------------------------------------------------------- + IF ( abflux ) THEN ! Ammonia Bidirectional Flux + + IF ( TRIM( depspc( l ) ) .EQ. 'NH3' ) THEN + cnh3 = cgridl1( n,c,r ) + +! Write(logdev,*) 'Before call Get_flux' + IF ( NINT( lwmask( c,r ) ) .NE. 0 ) THEN ! land + CALL Get_Flux( tempgcr,rh_air,cnh3,rwetsfc,rgw,wg(c,r),w2(c,r), + & sltyp(c,r),dif0(l),r,c,l,tpvd,lnh3, + & f_stom,f_cut,f_soil,f_emis,f_dep,f_ag,f_nat, f_wat, + & dt(2), jtime ) + pvd( n,c,r ) = tpvd + depvel_gas( n,c,r ) = lnh3 + + cmp( 1,c,r ) = max( f_emis, 0.0 ) + cmp( 2,c,r ) = max( f_dep, 0.0 ) + cmp( 3,c,r ) = f_stom + cmp( 4,c,r ) = f_cut + cmp( 5,c,r ) = f_soil + cmp( 6,c,r ) = f_ag + cmp( 7,c,r ) = f_nat + cmp( 8,c,r ) = f_wat + + ELSE ! water + cmp( 2,c,r ) = depvel_gas( n,c,r ) * cnh3 + cmp( 8,c,r ) = depvel_gas( n,c,r ) * cnh3 + END IF + END IF ! 'NH3' + + END IF ! abflux + +C-------------------------------------------------------------------------- + IF ( sfc_hono ) THEN + +C HONO production via heterogeneous reaction on ground surfaces, +C 2NO2 = HONO + HNO3 +C Rate constant for the reaction = (3.0E-3/60)* (A/V), +C where A/V is surface area/volume ratio +C HONO is produced and released into the atmosphere +C NO2 is lost via chemical reaction +C HNO3 is sticky and stays on the surfaces + +C Calculate A/V for leaves. +C LAI was multiplied by 2 to account for the fact that surface area +C is provided by both sides of the leaves. +C Matthews Jones, Ammonia deposition to semi-natural vegetation, +C PhD dissertation, University of Dundee, Scotland, 2006 + + surf_leaf = 2.0 * laicr / zf( c,r ) + +C Calculate A/V for buildings and other structures. +C Buildings and other structures can provide additional surfaces in +C urban areas for the heterogeneous reaction to occur. However, such +C information is not readily available; in the absence of such information, +C it is scaled to purb(c,r). Svensson et al., (1987) suggests a typical value +C of 0.2 for A/V for buildings in urban environments. A maximum value of 0.2 +C for A/V for buildings is assigned to the grid cell containing the highest +C purb(c,r) i.e., 100.0. A/V for buildings for other grid-cell is calculated +C as purb(c,r)*(0.2/100.0); Cai et al. (2006) used a value of 1.0 for their +C study at New York (total A/V) + + surf_bldg = purb( c,r ) * 0.002 + +C Calculate rate constant for the reaction (psudeo-first order reaction, +C unit per second). Calculate pseudo-first order rate constant using Eq 1 +C of Vogel et al. (2003). Unit of KNO2 is in 1/min in the paper; divide it +C by 60 to convert it into 1/sec. + +! kno2 = MAX( 0.0, 3.0E-3 * (surf_leaf + surf_bldg) / 60.0 ) + kno2 = MAX( 0.0, 5.0E-5 * (surf_leaf + surf_bldg) ) + +C Determine NO2 concentration needed for HONO production term. + + IF ( TRIM( depspc( l ) ) .EQ. 'NO2' ) THEN + conc_no2 = cgridl1( n,c,r ) + +C Loss of NO2 via the heterogeneous reaction is accounted as additional +C depositional loss. Add the loss of NO2 via the heterogeneous reaction +C to the regular deposition velocity (increased dep. vel.). This will +C reduce the NO2 conc. in the atmosphere. Dep vel is adjusted back to the +C original value in vdiffacm2 after NO2 conc is reduced but before calculating +C depositional loss. + +! depvel_gas( n,c,r ) = depvel_gas( n,c,r ) + 2.0 * kno2 * zf( c,r ) + + END IF + +C Calculate production (pvd) for HONO; unit = ppm * m/s + + IF ( TRIM( depspc( l ) ) .EQ. 'HONO' ) + & pvd( n,c,r ) = kno2 * conc_no2 * zf( c,r ) + + END IF +C-------------------------------------------------------------------------- + + ! Check for negative values or NaN's + + IF ( depvel_gas( n,c,r ) .LT. 0.0 .OR. + & depvel_gas( n,c,r ) .NE. depvel_gas( n,c,r ) ) GO TO 999 + + END IF ! special condition for sulfate (SULF) + + END DO ddloop ! (l = 1, n_spc_m3dry) + + END DO ! c + END DO ! r + + RETURN + +C------------------------------------------------------------------------------- +C Error-handling section. +C------------------------------------------------------------------------------- + +999 CONTINUE + WRITE( logdev,9003 ) c, r, TRIM( subname( l ) ), depvel_gas( n,c,r ) + xmsg = 'ABORT' + +1001 CONTINUE + + CALL m3exit( pname, jdate, jtime, xmsg, xstat1 ) + + RETURN + +C------------------------------------------------------------------------------- +C Format statements. +C------------------------------------------------------------------------------- + +6501 FORMAT(/ 1x, 70('='), + & / 1x, '--- Subroutine: M3DRY', + & / 1x, '--- Found canopy wetness (WR) in MET_CRO_2D ', + & / 1x, 70('=') /) + +6503 FORMAT(/ 1x, 70('='), + & / 1x, '--- Subroutine: M3DRY', + & / 1x, '--- Found 2-m water vapor mixing ratio (Q2) in MET_CRO_2D', + & / 1x, 70('=') /) + +9001 FORMAT( 'Failure reading ', a, 1x, 'from ', a ) + +9003 FORMAT(/ 1x, 70('*'), + & / 1x, '*** Subroutine: M3DRY', + & / 1x, '*** NEGATIVE or UNDEFINED Dry Deposition Velocity', + & / 1x, '*** Point = ', 2i5, + & / 1x, '*** Species = ', a, + & / 1x, '*** Vd = ', e13.6, + & / 1x, 70('*') /) + +9005 FORMAT(/ 1x, 70('*'), + & / 1x, '*** Subroutine: M3DRY', + & / 1x, '*** Bidirectional flux for ammonia assumes ', + & / 1x, '*** USGS 24-category land use.', + & / 1x, '*** Need to update N_LUFRAC, LUF_FAC, and other places', + & / 1x, '*** Land use description is: ', a, + & / 1x, 70('*') /) +9033 FORMAT(/ 1x, 70('*'), + & / 1x, '*** Subroutine: M3DRY', + & / 1x, '*** NEGATIVE or UNDEFINED Land use specific Dry Deposition Velocity', + & / 1x, '*** Column = ', i5, + & / 1x, '*** Row = ', i5, + & / 1x, '*** Luc = ', i5, + & / 1x, '*** Species = ', a, + & / 1x, '*** Vd = ', e13.6, + & / 1x, '*** lai = ', g10.3, + & / 1x, '*** z0 = ', g10.3, + & / 1x, '*** ustar = ', g10.3, + & / 1x, '*** rgndc = ', g10.3, + & / 1x, '*** Ra = ', g10.3, + & / 1x, '*** Rbc = ', g10.3, + & / 1x, '*** Rsurf = ', g10.3, + & / 1x, '*** Rstom = ', g10.3, + & / 1x, '*** Rcut = ', g10.3, + & / 1x, '*** Rwetsfc = ', g10.3, + & / 1x, '*** Rgnd = ', g10.3, + & / 1x, '*** Rgw = ', g10.3, + & / 1x, '*** Delta = ', g10.3, + & / 1x, '*** Veg = ', g10.3, + & / 1x, '*** Xm = ', g10.3, + & / 1x, '*** Rsndiff = ', g10.3, + & / 1x, '*** ifsnow = ', i6 + & / 1x, 70('*') /) + +9034 FORMAT(/ 1x, 70('*'), + & / 1x, '*** Subroutine: M3DRY', + & / 1x, '*** NEGATIVE or UNDEFINED Land use specific Dry Deposition Velocity', + & / 1x, '*** Column = ', i5, + & / 1x, '*** Row = ', i5, + & / 1x, '*** Luc = ', i5, + & / 1x, '*** Species = ', a, + & / 1x, '*** Vdfstj = ', e13.6, + & / 1x, '*** Rcanj = ', e13.6, + & / 1x, '*** Rstcj = ', e13.6, + & / 1x, '*** Rstomj = ', e13.6, + & / 1x, 70('*') /) + + END SUBROUTINE m3dry diff --git a/models/CCTM/depv/blank/opdepv_diag.F b/models/CCTM/depv/blank/opdepv_diag.F new file mode 100755 index 0000000..e9823b6 --- /dev/null +++ b/models/CCTM/depv/blank/opdepv_diag.F @@ -0,0 +1,163 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/opdepv_diag.F,v 1.7 2012/01/19 14:27:23 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE OPDEPV_DIAG ( JDATE, JTIME, TSTEP, + & N_GDEPV_NAMES, GDEPV_NAMES, + & N_ADEPV_NAMES, ADEPV_NAMES ) +! & N_SDEPV_NAMES, SDEPV_NAMES) + +C 2006-Jun-30 - created by W Hutzell +C 2006-Dec-05 - modified by J.Young +C 2010-Jan-29 - removed unneccesary CLOSE3 statement for CTM_DEPV_DIAG file +C to eliminate potential MPI race condition (D.Wong) +C 2011-Feb-16 - replaced I/O API include files with UTILIO_DEFN (S.Roselle) +C 2011-May-20 - modified diagnostic file header creation (D.Schwede) + + USE GRID_CONF ! horizontal & vertical domain specifications + USE DEPVVARS + 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 + +C number and names of gas deposition velocities + INTEGER, INTENT( IN ) :: N_GDEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: GDEPV_NAMES( : ) + +C number and names of aerosol deposition velocities + INTEGER, INTENT( IN ) :: N_ADEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: ADEPV_NAMES( : ) + +C number and names of (SOA+aerosol) species deposition velocities +! INTEGER, INTENT( IN ) :: N_SDEPV_NAMES +! CHARACTER( 16 ), INTENT( IN ) :: SDEPV_NAMES( : ) + +C Local variables: + + CHARACTER( 16 ) :: PNAME = 'OPDDEP_DIAG' + CHARACTER( 96 ) :: XMSG = ' ' + INTEGER :: LOGDEV + + INTEGER V, N, L ! loop induction variables + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + +C Try to open existing file for update + + IF ( .NOT. OPEN3( CTM_DEPV_DIAG, FSRDWR3, PNAME ) ) THEN + + XMSG = 'Could not open ' // CTM_DEPV_DIAG // ' file for update - ' + & // 'try to open new' + CALL M3MESG( XMSG ) + +C Set output file characteristics based on GRIDDESC and open the dep velocity dignostic file + + SDATE3D = JDATE + STIME3D = JTIME + TSTEP3D = TSTEP + CALL NEXTIME( SDATE3D, STIME3D, TSTEP3D ) ! start the next hour + + FTYPE3D = GRDDED3 +! NVARS3D = N_GDEPV_NAMES + N_ADEPV_NAMES + N_SDEPV_NAMES + NVARS3D = N_GDEPV_NAMES + N_ADEPV_NAMES + 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 + DO L = 1, NLAYS3D + 1 + VGLVS3D( L ) = VGLVS_GD( L ) + END DO + GDNAM3D = GRID_NAME ! from HGRD_DEFN + + FDESC3D = ' ' ! array + + L = LEN_TRIM( DEPV_METHOD ) + FDESC3D( 1 ) = 'Instanteous values of dry deposition velocities:' + & // ' the gas phase velocities are' + FDESC3D( 2 ) = 'estimated by the ' + & // DEPV_METHOD( 1:L ) // ' algorithm.' + + N = 0 + + DO V = 1, N_GDEPV_NAMES + N = N + 1 + VTYPE3D( V ) = M3REAL + VNAME3D( V ) = GDEPV_NAMES( V ) + UNITS3D( V ) = 'cm/sec' + VDESC3D( V ) = 'gas phase dry deposition velocity' + END DO + + N = N_GDEPV_NAMES + + DO V = 1, N_ADEPV_NAMES + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = ADEPV_NAMES( V ) + UNITS3D( N ) = 'cm/sec' + VDESC3D( N ) = 'aerosol phase dry deposition velocity' + END DO + +! N = N_GDEPV_NAMES + N_ADEPV_NAMES + +! DO V = 1, N_SDEPV_NAMES +! N = N + 1 +! VTYPE3D( N ) = M3REAL +! VNAME3D( N ) = SDEPV_NAMES( V ) +! UNITS3D( N ) = 'cm/sec' +! VDESC3D( N ) = 'deposition velocity for (GAS-AEROSOL) ' +! & // ' semi-volatile compound' +! END DO + +C Open diagnostic file, then close it for subsequent open by all processors + + IF ( .NOT. OPEN3( CTM_DEPV_DIAG, FSNEW3, PNAME ) ) THEN + XMSG = 'Could not create '// TRIM( CTM_DEPV_DIAG ) // ' file' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + END IF + + RETURN + END diff --git a/models/CCTM/depv/blank/opdepv_fst.F b/models/CCTM/depv/blank/opdepv_fst.F new file mode 100755 index 0000000..75933cf --- /dev/null +++ b/models/CCTM/depv/blank/opdepv_fst.F @@ -0,0 +1,160 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/opdepv_fst.F,v 1.4 2012/01/19 14:27:23 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE OPDEPV_FST ( JDATE, JTIME, TSTEP, + & N_GDEPV_NAMES, GDEPV_NAMES, + & N_ADEPV_NAMES, ADEPV_NAMES ) +! & N_SDEPV_NAMES, SDEPV_NAMES) + +C 2011-May-20 - created by D.Schwede - modified from opdepv_diag.F + + USE GRID_CONF ! horizontal & vertical domain specifications + USE DEPVVARS + USE UTILIO_DEFN + USE LSM_Mod, Only: N_LUFRAC + + 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 + +C number and names of gas deposition velocities + INTEGER, INTENT( IN ) :: N_GDEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: GDEPV_NAMES( : ) + +C number and names of aerosol deposition velocities + INTEGER, INTENT( IN ) :: N_ADEPV_NAMES + CHARACTER( 16 ) :: ADEPV_NAMES( : ) + +C number and names of (SOA+aerosol) species deposition velocities +! INTEGER, INTENT( IN ) :: N_SDEPV_NAMES +! CHARACTER( 16 ), INTENT( IN ) :: SDEPV_NAMES( : ) + +C Local variables: + + CHARACTER( 16 ) :: PNAME = 'OPDEPV_FST' + CHARACTER( 96 ) :: XMSG = ' ' + INTEGER :: LOGDEV + + INTEGER V, N, L ! loop induction variables + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + + +C Try to open existing file for update + + IF ( .NOT. OPEN3( CTM_DEPV_FST, FSRDWR3, PNAME ) ) THEN + + XMSG = 'Could not open ' // CTM_DEPV_FST // ' file for update - ' + & // 'try to open new' + CALL M3MESG( XMSG ) + +C Set output file characteristics based on COORD.EXT and open the dep velocity file + + SDATE3D = JDATE + STIME3D = JTIME + TSTEP3D = TSTEP + CALL NEXTIME( SDATE3D, STIME3D, TSTEP3D ) ! start the next hour + + FTYPE3D = GRDDED3 +! NVARS3D = N_GDEPV_NAMES + N_ADEPV_NAMES + N_SDEPV_NAMES + NVARS3D = N_GDEPV_NAMES + N_ADEPV_NAMES + NCOLS3D = GL_NCOLS + NROWS3D = GL_NROWS + NLAYS3D = N_LUFRAC ! preempting normal use of vertical layers + 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 +! DO L = 1, NLAYS3D + 1 +! VGLVS3D( L ) = VGLVS_GD( L ) +! END DO + GDNAM3D = GRID_NAME ! from HGRD_DEFN + + FDESC3D = ' ' ! array + + L = LEN_TRIM( DEPV_METHOD ) + FDESC3D( 1 ) = 'Instanteous values of stomatal dry deposition velocities:' + & // ' the gas phase velocities are' + FDESC3D( 2 ) = 'estimated by the ' + & // DEPV_METHOD( 1:L ) // ' algorithm.' + + N = 0 + + DO V = 1, N_GDEPV_NAMES + N = N + 1 + VTYPE3D( V ) = M3REAL + VNAME3D( V ) = GDEPV_NAMES( V ) + UNITS3D( V ) = 'cm/sec' + VDESC3D( V ) = 'gas phase dry deposition velocity' + END DO + + N = N_GDEPV_NAMES + + DO V = 1, N_ADEPV_NAMES + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = ADEPV_NAMES( V ) + UNITS3D( N ) = 'cm/sec' + VDESC3D( N ) = 'aerosol phase dry deposition velocity' + END DO + +! N = N_GDEPV_NAMES + N_ADEPV_NAMES + +! DO V = 1, N_SDEPV_NAMES +! N = N + 1 +! VTYPE3D( N ) = M3REAL +! VNAME3D( N ) = SDEPV_NAMES( V ) +! UNITS3D( N ) = 'cm/sec' +! VDESC3D( N ) = 'deposition velocity for (GAS-AEROSOL) ' +! & // ' semi-volatile compound' +! END DO + +C Open diagnostic file + + IF ( .NOT. OPEN3( CTM_DEPV_FST, FSNEW3, PNAME ) ) THEN + XMSG = 'Could not create '// TRIM( CTM_DEPV_FST ) // ' file' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + END IF + + RETURN + END diff --git a/models/CCTM/depv/blank/opdepv_mos.F b/models/CCTM/depv/blank/opdepv_mos.F new file mode 100755 index 0000000..f4d46d9 --- /dev/null +++ b/models/CCTM/depv/blank/opdepv_mos.F @@ -0,0 +1,185 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/depv/m3dry/opdepv_mos.F,v 1.4 2012/01/19 14:27:24 yoj Exp $ + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE OPDEPV_MOS ( JDATE, JTIME, TSTEP, + & N_GDEPV_NAMES, GDEPV_NAMES, + & N_ADEPV_NAMES, ADEPV_NAMES ) +! & N_SDEPV_NAMES, SDEPV_NAMES ) + +C 2011-May-20 - created by D.Schwede - modified from opdepv_diag.F + + USE GRID_CONF ! horizontal & vertical domain specifications + USE DEPVVARS + USE UTILIO_DEFN + USE LSM_Mod, Only: N_LUFRAC + + 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 + +C number and names of gas deposition velocities + INTEGER, INTENT( IN ) :: N_GDEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: GDEPV_NAMES( : ) + +C number and names of aerosol deposition velocities + INTEGER, INTENT( IN ) :: N_ADEPV_NAMES + CHARACTER( 16 ), INTENT( IN ) :: ADEPV_NAMES( : ) + +C number and names of (SOA+aerosol) species deposition velocities +! INTEGER N_SDEPV_NAMES +! CHARACTER( 16 ) :: SDEPV_NAMES( : ) + +C Local variables: + + CHARACTER( 16 ) :: PNAME = 'OPDEPV_MOS' + CHARACTER( 96 ) :: XMSG = ' ' + INTEGER :: LOGDEV + + INTEGER V, N, L ! loop induction variables + +C----------------------------------------------------------------------- + + LOGDEV = INIT3() + +C Try to open existing file for update + + IF ( .NOT. OPEN3( CTM_DEPV_MOS, FSRDWR3, PNAME ) ) THEN + + XMSG = 'Could not open ' // CTM_DEPV_MOS // ' file for update - ' + & // 'try to open new' + CALL M3MESG( XMSG ) + +C Set output file characteristics based on GRIDDESC and open the dep velocity dignostic file + + SDATE3D = JDATE + STIME3D = JTIME + TSTEP3D = TSTEP + CALL NEXTIME( SDATE3D, STIME3D, TSTEP3D ) ! start the next hour + + FTYPE3D = GRDDED3 +! NVARS3D = N_GDEPV_NAMES + N_ADEPV_NAMES + N_SDEPV_NAMES + 4 + NVARS3D = N_GDEPV_NAMES + N_ADEPV_NAMES + 4 + NCOLS3D = GL_NCOLS + NROWS3D = GL_NROWS + NLAYS3D = N_LUFRAC ! preempting normal use of vertical layers + 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 +! DO L = 1, NLAYS3D + 1 +! VGLVS3D( L ) = VGLVS_GD( L ) +! END DO + GDNAM3D = GRID_NAME ! from HGRD_DEFN + + FDESC3D = ' ' ! array + + L = LEN_TRIM( DEPV_METHOD ) + FDESC3D( 1 ) = 'Instanteous values of land use specific' + & // ' dry deposition velocities:' + & // ' the gas phase velocities are' + FDESC3D( 2 ) = 'estimated by the ' + & // DEPV_METHOD( 1:L ) // ' algorithm.' + + N = 0 + + DO V = 1, N_GDEPV_NAMES + N = N + 1 + VTYPE3D( V ) = M3REAL + VNAME3D( V ) = GDEPV_NAMES( V ) + UNITS3D( V ) = 'cm/sec' + VDESC3D( V ) = 'gas phase dry deposition velocity' + END DO + + N = N_GDEPV_NAMES + + DO V = 1, N_ADEPV_NAMES + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = ADEPV_NAMES( V ) + UNITS3D( N ) = 'cm/sec' + VDESC3D( N ) = 'aerosol phase dry deposition velocity' + END DO + + N = N_GDEPV_NAMES + N_ADEPV_NAMES + +! DO V = 1, N_SDEPV_NAMES +! N = N + 1 +! VTYPE3D( N ) = M3REAL +! VNAME3D( N ) = SDEPV_NAMES( V ) +! UNITS3D( N ) = 'cm/sec' +! VDESC3D( N ) = 'deposition velocity for (GAS-AEROSOL) ' +! & // ' semi-volatile compound' +! END DO + + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = 'LAIJ' + UNITS3D( N ) = 'dimensionless' + VDESC3D( N ) = 'leaf area index for land use category' + + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = 'RAJ' + UNITS3D( N ) = 'm/sec' + VDESC3D( N ) = 'aerodynamic resistance for land use category' + + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = 'USTARJ' + UNITS3D( N ) = 'm/sec' + VDESC3D( N ) = 'friction velocity for land use category' + + N = N + 1 + VTYPE3D( N ) = M3REAL + VNAME3D( N ) = 'Z0J' + UNITS3D( N ) = 'm/sec' + VDESC3D( N ) = 'surface roughness for land use category' + + +C Open diagnostic file + + IF ( .NOT. OPEN3( CTM_DEPV_MOS, FSNEW3, PNAME ) ) THEN + XMSG = 'Could not create '// TRIM( CTM_DEPV_MOS) // ' file' + CALL M3EXIT( PNAME, JDATE, JTIME, XMSG, XSTAT1 ) + END IF + + END IF + + RETURN + END diff --git a/models/CCTM/emis/emis/DUST_EMIS.F b/models/CCTM/emis/emis/DUST_EMIS.F index 03a1564..0b1b6ac 100644 --- a/models/CCTM/emis/emis/DUST_EMIS.F +++ b/models/CCTM/emis/emis/DUST_EMIS.F @@ -128,10 +128,14 @@ module dust_emis integer :: n, idx integer, parameter :: ndltyp = 3 ! number of desert land type beld1 +C character( 16 ) :: vnmld( ndltyp ) = (/ +C & 'USGS_shrubland ', +C & 'USGS_shrubgrass', +C & 'USGS_sprsbarren' /) character( 16 ) :: vnmld( ndltyp ) = (/ - & 'USGS_shrubland ', - & 'USGS_shrubgrass', - & 'USGS_sprsbarren' /) + & 'LUFRAC_08 ', + & 'LUFRAC_09 ', + & 'LUFRAC_19 ' /) 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. @@ -433,18 +437,8 @@ end subroutine tfbelow end if - call subhfile ( dust_lu_1, gxoff, gyoff, - & strtcol_01, endcol_01, strtrow_01, endrow_01 ) - -C Get desert land (fraction) data - do i = 1, ndltyp - if ( .not. xtract3( dust_lu_1, vnmld( i ), - & 1,1, strtrow_01,endrow_01, strtcol_01,endcol_01, - & 0, 0, ladut( 1,1,i ) ) ) then - xmsg = 'Could not read ' // trim( vnmld( i ) ) // ' from DUST_LU_1' - call m3exit( pname, jdate, jtime, xmsg, xstat1 ) - end if - end do +C call subhfile ( dust_lu_1, gxoff, gyoff, +C & strtcol_01, endcol_01, strtrow_01, endrow_01 ) call subhfile ( met_cro_2d, gxoff, gyoff, & strtcolmc2, endcolmc2, strtrowmc2, endrowmc2 ) @@ -452,6 +446,16 @@ end subroutine tfbelow call subhfile ( grid_cro_2d, gxoff, gyoff, & strtcolgc2, endcolgc2, strtrowgc2, endrowgc2 ) +C Get desert land (fraction) data + do i = 1, ndltyp + if ( .not. interpx( grid_cro_2d, vnmld( i ), pname, + & strtcolgc2, endcolgc2, strtrowgc2, endrowgc2, 1, 1, + & jdate, jtime, ladut( 1,1,i ) ) ) then + xmsg = 'Could not read ' // trim( vnmld( i ) ) // ' from GRID_CRO_2D' + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) + end if + end do + C Get soil type data ! if ( metmod .eq. 'mm5' ) then vname = 'SLTYP' diff --git a/models/CCTM/emis/emis/tfbelow.F b/models/CCTM/emis/emis/tfbelow.F index ef6e857..b0fbeec 100644 --- a/models/CCTM/emis/emis/tfbelow.F +++ b/models/CCTM/emis/emis/tfbelow.F @@ -66,18 +66,42 @@ subroutine tfbelow ( jdate, jtime, uland, tfb ) ! integer, parameter :: nlutyp = 21 ! number of landuse types !!!!!!! 12 km missing 'AGRICULTURE' integer, parameter :: nlutyp = 20 ! number of landuse types + integer, parameter :: nlutyp_usgs = 24 ! number of landuse types in the USGS database character( 16 ) :: vnmld( nlutyp ) = - & (/ 'USGS_urban ', 'USGS_drycrop ', 'USGS_irrcrop ', - & 'USGS_cropgrass ', 'USGS_cropwdlnd ', 'USGS_grassland ', - & 'USGS_shrubland ', 'USGS_shrubgrass ', 'USGS_savanna ', - & 'USGS_decidforest', 'USGS_evbrdleaf ', 'USGS_coniferfor ', - & 'USGS_mxforest ', 'USGS_water ', 'USGS_wetwoods ', - & 'USGS_sprsbarren ', 'USGS_woodtundr ', 'USGS_mxtundra ', -! & 'USGS_snowice ', 'AGRICULTURE ', 'FOREST ' /) - & 'USGS_snowice ', 'FOREST ' /) - - real :: lut( ncols,nrows,nlutyp ) ! landuse type fraction + & (/ 'USGS_urban ', ! 1 LUFRAC_01: Urban Land + $ 'USGS_drycrop ', ! 2 LUFRAC_02: Dryland Cropland and Pasture, LUFRAC_04: Mixed Dryland and Irrigated Cropland and Pasture, + $ 'USGS_irrcrop ', ! 3 LUFRAC_03: Irrigated Cropland and Pasture + $ 'USGS_cropgrass ', ! 4 LUFRAC_05: Cropland-Grassland Mosaic + $ 'USGS_cropwdlnd ', ! 5 LUFRAC_06: Cropland-Woodland Mosaic + $ 'USGS_grassland ', ! 6 LUFRAC_07: Grassland + $ 'USGS_shrubland ', ! 7 LUFRAC_08: Shrubland + $ 'USGS_shrubgrass ', ! 8 LUFRAC_09: Mixed Shrubland-Grassland + $ 'USGS_savanna ', ! 9 LUFRAC_10: Savannah + $ 'USGS_decidforest', ! 10 LUFRAC_11: Deciduous Broadleaf Forest, + $ 'USGS_evbrdleaf ', ! 11 LUFRAC_13: Evergreen Broadleaf Forest, + $ 'USGS_coniferfor ', ! 12 LUFRAC_12: Deciduous Needleleaf Forest, LUFRAC_14: Evergreen Needleleaf Forest + $ 'USGS_mxforest ', ! 13 LUFRAC_15: Mixed Forest + $ 'USGS_water ', ! 14 LUFRAC_16: Water + $ 'USGS_wetwoods ', ! 15 LUFRAC_17: Herbaceous Wetland, LUFRAC_18: Wooded Wetland + $ 'USGS_sprsbarren ', ! 16 LUFRAC_19: Barren or Sparsely Vegetated + $ 'USGS_woodtundr ', ! 17 LUFRAC_21: Wooded Tundra + $ 'USGS_mxtundra ', ! 18 LUFRAC_22: Mixed Tundra, LUFRAC_20: Herbaceous Tundra, LUFRAC_23: Bare Ground Tundra + $ 'USGS_snowice ', ! 19 LUFRAC_24: Snow or Ice + $ 'FOREST ' /) ! 20 + + character( 16 ) :: vnmld_usgs + integer, parameter :: nusgs = 24 +! map from USGS to ULAND categories, length = 24 + integer :: id_usgs(nusgs) = (/3, 2, 2, 2, 2, 2, 2, 1, 2, 2, 4, 4, 4, 4, 4, 1, 4, 4, 1, 1, 2, 1, 1, 1/) +! map from USGS to BEIS3 categories +! (/1,2,3,2,4,5,6,7,8,9,10,12,11,12,13,14,15,15,16,18,17,18,18,19/) ! length = 24 +! map from BEIS3 categories to ULAND categories +! (/3, 2, 2, 2, 2, 2, 1, 2, 2, 4, 4, 4, 4, 1, 4, 1, 2, 1, 1, 4/) ! length = 20 + + + + real :: lut( ncols,nrows ) ! landuse type fraction C uland merging: C water & barren surrounding @@ -111,7 +135,7 @@ subroutine tfbelow ( jdate, jtime, uland, tfb ) real :: ufc ! total weighted removal fraction for each cell real :: tland - integer i, c, r + integer :: i, j, c, r real :: fw( 4 ) = ! removal fraction in and below canopy & (/ 0.0, ! water @@ -125,99 +149,42 @@ subroutine tfbelow ( jdate, jtime, uland, tfb ) integer gxoff, gyoff ! global origin offset from file integer, save :: strtcol_01, endcol_01, strtrow_01, endrow_01 - integer, save :: strtcol_02, endcol_02, strtrow_02, endrow_02 - -! integer allocstat -c----------------------------------------------------------------------- - -!dqt: We have disabled the rain impact on FW(2) -!dqt if ( .not. open3( hname, fsread3, pname ) ) then -!dqt xmsg = 'could not open ' // hname // ' file' -!dqt call m3exit( pname, jdate, jtime, xmsg, xstat1 ) -!dqt end if - -!dqt call subhfile ( hname, gxoff, gyoff, -!dqt & strtcol, endcol, strtrow, endrow ) - -!dqt allocate ( rainf( ncols,nrows ), stat = allocstat ) -!dqt if ( allocstat .ne. 0 ) then -!dqt xmsg = 'Failure allocating rainf' -!dqt call m3exit( pname, jdate, jtime, xmsg, xstat1 ) -!dqt end if - -!dqt if ( .not. interpx ( hname, 'rain', pname, -!dqt & strtcol,endcol,strtrow,endrow, 1,1, -!dqt & jdate, jtime, rainf ) ) then -!dqt xmsg = 'Could not read rainfall from ' // hname -!dqt call m3exit ( pname, jdate, jtime, xmsg, xstat1 ) -!dqt end if - -C Open the BELD1 file - if ( .not. open3( dust_lu_1, fsread3, pname ) ) then - xmsg = 'Could not open ' // dust_lu_1 // ' file' - call m3exit( pname, 0, 0, xmsg, xstat1 ) - end if - -C Open the BELD3 file - if ( .not. open3( dust_lu_2, fsread3, pname ) ) then - xmsg = 'Could not open ' // dust_lu_2 // ' file' - call m3exit( pname, 0, 0, xmsg, xstat1 ) - end if C Get domain window info - call subhfile ( dust_lu_1, gxoff, gyoff, - & strtcol_01, endcol_01, strtrow_01, endrow_01 ) - - call subhfile ( dust_lu_2, gxoff, gyoff, - & strtcol_02, endcol_02, strtrow_02, endrow_02 ) - -C Get landuse (fraction) data -! do i = 1, nlutyp-2 ! dust_lu_1 - do i = 1, nlutyp-1 ! dust_lu_1 - if ( .not. xtract3( dust_lu_1, vnmld( i ), 1,1, - & strtrow_01,endrow_01, strtcol_01,endcol_01, - & 0, 0, lut( 1,1,i ) ) ) then - xmsg = 'Could not read ' // trim( vnmld( i ) ) // ' from DUST_LU_1' - call m3exit ( pname, 0, 0, xmsg, xstat1 ) + call subhfile ( grid_cro_2d, gxoff, gyoff, + & strtcol_01, endcol_01, strtrow_01, endrow_01 ) + +C Get desert land (fraction) data + do i = 1, nusgs + write(vnmld_usgs,'(A,I0.2)') 'LUFRAC_',i + if ( .not. interpx( grid_cro_2d, vnmld_usgs, pname, + & strtcol_01,endcol_01, strtrow_01,endrow_01, 1,1, + & jdate, jtime, lut ) ) then + xmsg = 'Could not read ' // trim( vnmld( i ) ) // ' from GRIDCRO2D file' + call m3exit( pname, jdate, jtime, xmsg, xstat1 ) end if + j = id_usgs(i) + do r = 1, my_nrows + do c = 1, my_ncols + uland( c,r,j ) = uland( c,r,j ) + lut( c,r) + end do + end do end do -! do i = nlutyp-1, nlutyp ! dust_lu_2 - do i = nlutyp, nlutyp ! dust_lu_2 - if ( .not. xtract3( dust_lu_2, vnmld( i ), 1,1, - & strtrow_02,endrow_02, strtcol_02,endcol_02, - & 0, 0, lut( 1,1,i ) ) ) then - xmsg = 'Could not read ' // trim( vnmld( i ) ) // ' from DUST_LU_2' - call m3exit ( pname, 0, 0, xmsg, xstat1 ) - end if - end do C Merge fractional BELD landuse types into 4 categories for dust removal do r = 1, my_nrows do c = 1, my_ncols - uland( c,r,1 ) = lut( c,r,7 ) + lut( c,r,14 ) ! water & barren surrounding - & + lut( c,r,16 ) + lut( c,r,18 ) - & + lut( c,r,19 ) - uland( c,r,2 ) = lut( c,r,6 ) + lut( c,r,8 ) ! grass surrounding - & + lut( c,r,9 ) + lut( c,r,17 ) - & + lut( c,r,2 ) + lut( c,r,3 ) ! crop surrounding - & + lut( c,r,4 ) + lut( c,r,5 ) -! & + lut( c,r,20 ) - uland( c,r,3 ) = lut( c,r,1 ) ! building surrounding - uland( c,r,4 ) = lut( c,r,10 ) + lut( c,r,11 ) ! forest surrounding - & + lut( c,r,12 ) + lut( c,r,13 ) -! & + lut( c,r,15 ) + lut( c,r,21 ) - & + lut( c,r,15 ) + lut( c,r,20 ) tland = 0.0 do i = 1, 4 - uland( c,r,i ) = max( 0.0, min( 100.0, uland( c,r,i ) ) ) + uland( c,r,i ) = max( 0.0, min( 1.0, uland( c,r,i ) ) ) tland = tland + uland( c,r,i ) end do - if ( tland .gt. 100.0 ) then + if ( tland .gt. 1.0 ) then do i = 1, 4 - uland( c,r,i ) = uland( c,r,i ) * 100.0 / tland + uland( c,r,i ) = uland( c,r,i ) * 1.0 / tland end do end if @@ -226,11 +193,9 @@ subroutine tfbelow ( jdate, jtime, uland, tfb ) ufc = 0.0 do i = 1, 4 -! ufc = ufc + fw( i ) * uland( c,r,i ) * 0.01 ufc = ufc + fw( i ) * uland( c,r,i ) end do -! tfb( c,r ) = 1.0 - ufc - tfb( c,r ) = 1.0 - ufc * 0.01 + tfb( c,r ) = 1.0 - ufc if ( tfb( c,r ) .gt. 1.0 .or. tfb( c,r ) .lt. 0.0 ) then write( xmsg,'( a, e10.3, a, 2i4 )' ) 'Transport factor error: ', diff --git a/models/CCTM/gas/blank/gas_driver.F b/models/CCTM/gas/blank/gas_driver.F new file mode 100755 index 0000000..9b6b415 --- /dev/null +++ b/models/CCTM/gas/blank/gas_driver.F @@ -0,0 +1,198 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ros3/rbdriver.F,v 1.7 2011/10/21 16:11:10 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + + SUBROUTINE CHEM( CONC, JDATE, JTIME, TSTEP ) + +C********************************************************************** +C +C Function: To control gas phase chemistry calculations performed by +C the vectorized Rosenbrock solver +C +C Preconditions: None +C +C Key Subroutines/Functions Called: RBINIT +C RBSPARSE +C PHOT +C CALCKS +C RBSOLVER +C FIND_DEGRADED +C INIT_DEGRADE +C FINAL_DEGRADE +C +C Revision History: Prototype created by Jerry Gipson, August, 2004 +C Based on the solver described by Sandu et al +C ( Atm. Env., Vol. 31, No. 20, 1997 ) and included +C in the Kinetic PreProcessor ( see for example +C Sandu et al., At, Env., Vol. 37, 5097-5114, +C 2003). This code also incorporates efficiency +C concepts originally developed by M. Jacobson +C for SMVGEAR (Atm. Env., Vol 28, No 2, 1994). +C Adapted from Subroutine CHEM in CMAQ SMVGEAR +C +C 31 Jan 05 J.Young: dyn alloc - establish both horizontal +C & vertical domain specifications in one module (GRID_CONF) +C 29 Jul 05 WTH: Added IF blocks that call degrade +C routines if MECHNAME contains 'TX' +C substring. +C 28 Jun 10 J.Young: convert for Namelist redesign +C 29 Mar 11 S.Roselle: Replaced I/O API include files +C with UTILIO_DEFN +C 31 Aug 11 B.Hutzell revised method that determines calling +C degrade routine +C 29 Sep 11 D.Wong: incorporated twoway model implementation +C********************************************************************** + + USE SUBST_MODULES + USE GRID_CONF ! horizontal & vertical domain specifications +C USE RBDATA ! ROS3 solver data + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + + IMPLICIT NONE + +C..Includes: + + INCLUDE SUBST_FILES_ID ! CMAQ files + INCLUDE SUBST_CONST ! CMAQ constants + INCLUDE SUBST_RXCMMN ! Mechanism reaction common block + INCLUDE SUBST_PACTL_ID ! Process analysis control parameters + +C..Arguments: + + REAL, POINTER :: CONC( :,:,:,: ) ! Concentrations + + INTEGER JDATE ! Current date (YYYYDDD) + INTEGER JTIME ! Current time (HHMMSS) + INTEGER TSTEP( 3 ) ! Time step vector (HHMMSS) + +C..Parameters: + + INTEGER, PARAMETER :: IZERO = 0 ! Integer zero + + REAL, PARAMETER :: CONCMIN = 1.0E-30 ! Minimum conc + REAL, PARAMETER :: CONCOFM = 1.0E+06 ! conc. of M = 1E+06 ppm + REAL, PARAMETER :: PA2ATM = 1.0 / STDATMPA ! Pascal to atm conv fac + +C..External Functions: + +C..Local Variables: + + LOGICAL, SAVE :: LFIRST = .TRUE. ! Flag for first call to this subroutine + LOGICAL, SAVE :: LIRRBLK ! Flag for IRR to be done for block + + INTEGER, SAVE :: LOGDEV ! Unit number of output log + INTEGER, SAVE :: NOXYZ ! Total number of grid cells + + REAL, SAVE :: AIRFC ! Factor to convert gms air to ppm + REAL, SAVE :: MAOMV ! Mol Wt of air over Mol Wt of water +! REAL, SAVE :: CONV( NLAYS ) ! Volumetric emis conv facs + + CHARACTER( 16 ) :: PNAME = 'RBDRIVER' ! Procedure name + CHARACTER( 16 ) :: VNAME ! Name of I/O API data variable + CHARACTER( 144 ) :: MSG ! Message text + + INTEGER C, R, L, S ! Loop indices + INTEGER ALLOCSTAT ! Allocate status code + INTEGER OFFSET ! Starting cell number of a block + INTEGER NCSP ! Mech no: 1=gas/day 2=gas/night + INTEGER BLK ! Loop index for block of cells + INTEGER CELLNUM ! Cell number + INTEGER COL ! Column index + INTEGER IPAR ! Pointer for cell sort routine + INTEGER IRVAL ! Pointer for cell sort routine + INTEGER IRXN ! Reaction number + INTEGER ISP ! Species index + INTEGER ISPOLD ! Species number in original order + INTEGER ISPNEW ! Species number in new sorted order + INTEGER ITMSTEP ! Chemistry integration interval (sec) + INTEGER JPAR ! Pointer for cell sort routine + INTEGER JREORD ! Index holder for sort routine + INTEGER LEV ! Layer index + INTEGER LVAL ! Pointer for cell sort routine + INTEGER MIDDATE ! Date at time step midpoint + INTEGER MIDTIME ! Time at time step midpoint + INTEGER NCELL ! Index for number of cells + INTEGER NDARK ! Number of layer 1 cells in darkness + INTEGER NIRRCLS ! No. of cells in block for IRR + INTEGER NPH ! Index for number of phot. rxns in PHOT + INTEGER NRX ! Index for number of reactions + INTEGER ROW ! Row index + INTEGER SPC ! Species loop index + INTEGER VAR ! Variable number on I/O API file + + INTEGER :: IRRCELL( BLKSIZE ) ! Cell No. of an IRR cell + +C for INTERPX + INTEGER GXOFF, GYOFF ! global origin offset from file + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + INTEGER, SAVE :: STRTCOLEM1, ENDCOLEM1, STRTROWEM1, ENDROWEM1 + + REAL CHEMSTEP ! Chem integration interval (min) + REAL VALLOW ! Value holder for sort routine + + REAL :: DENSA_J( NCOLS,NROWS,NLAYS ) ! Cell density (Kg/m**3) + REAL :: DENS ( NCOLS,NROWS,NLAYS ) ! Cell density (Kg/m**3) + REAL :: PRES ( NCOLS,NROWS,NLAYS ) ! Cell pressure (Pa) + REAL :: QV ( NCOLS,NROWS,NLAYS ) ! Cell water vapor (Kg/Kg air) + REAL :: TA ( NCOLS,NROWS,NLAYS ) ! Cell temperature (K) + +! REAL :: RJBLK( BLKSIZE,NPHOTAB ) ! J-values for each cell in + ! a block + + REAL :: RJ( NCOLS,NROWS,NLAYS,NPHOTAB ) ! J-values for each cell +! REAL, ALLOCATABLE, SAVE :: RJ( :,:,:,: ) ! J-values for each cell + +#ifdef rbstats + + CHARACTER( 16 ), SAVE :: CTM_RBSTATS_1 = 'CTM_RBSTATS_1' + CHARACTER( 16 ), ALLOCATABLE, SAVE :: VSTATS( : ) ! + + INTEGER, SAVE :: WSTEP = 0 + INTEGER, ALLOCATABLE, SAVE :: STAT_SUM( :,:,:,: ) + INTEGER EDATE, ETIME + + REAL :: STATOUT( NCOLS,NROWS,NLAYS ) + +#endif + +C********************************************************************** + + IF ( N_GC_SPC .EQ. 0 ) THEN + CALL M3MESG( '*** WARNING: Gas-Chemistry processing bypassed!' ) + RETURN + END IF + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c On first call, do nothing in particular... +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( LFIRST ) THEN + LFIRST = .FALSE. + LOGDEV = INIT3( ) + + END IF ! First call + + END + diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrcalcks.F b/models/CCTM/gas/ebi_cb05cl_RN/hrcalcks.F new file mode 100755 index 0000000..cbc3f5e --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrcalcks.F @@ -0,0 +1,299 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrcalcks.F,v 1.3 2011/10/21 16:10:49 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HRCALCKS( NJPHOT, LSUNLIGHT, RJIN, TEMP, PRES, H2O, RK ) + +C----------------------------------------------------------------------- +C Function: To compute thermal and photolytic reaction rate +C coefficients for each reaction. + +C Preconditions: Photolysis rates for individual species must have +C been calculated and stored in RKPHOT. Expects +C temperature in deg K, pressure in atm., water +C vapor in ppmV, and J-values in /min. + +C Key Subroutines/Functions Called: None + +C Revision History: Created by EBI solver program, Jan. 31, 2008 +C----------------------------------------------------------------------- + IMPLICIT NONE + +C..Includes: + INCLUDE SUBST_RXCMMN + +C..Arguments: + INTEGER NJPHOT ! Number of J-values set in PHOT + + LOGICAL LSUNLIGHT ! Flag for daytime + + REAL H2O ! Cell H2O mixing ratio (ppmV) + REAL TEMP ! Cell temperature (deg K) + REAL PRES ! Cell pressure (atm) + REAL( 8 ) :: RK( NRXNS ) + REAL RJIN( NJPHOT ) ! J-values for each cell + +C..Parameters: + REAL, PARAMETER :: COEF1 = 7.33981E+15 ! Molec/cc to ppm conv factor coefficient + REAL, PARAMETER :: CONSTC = 0.6 ! Constant for reaction type 7 + REAL, PARAMETER :: TI300 = 1.0 / 300.0 + +C..External Functions: None + +C..Saved Local Variables: + CHARACTER( 16 ), SAVE :: PNAME = 'HRCALCKS' + +C..Scratch Local Variables: + INTEGER NRT ! Loop index for reaction types + INTEGER IRXN ! Reaction number + INTEGER JNUM ! J-value species # from PHOT + INTEGER KNUM ! Reaction # for a relative rate coeff. + INTEGER N ! Loop index for reactions + + REAL RK0 ! K0 in falloff rate expressions + REAL RK1 ! k1 in falloff rate expressions + REAL RK2 ! K2 in falloff rate expressions + REAL RK3 ! K3 in falloff rate expressions + REAL XEND ! Exponent in falloff rate expressions + REAL( 8 ) :: CFACT ! molec/cc to ppm conversion factor + REAL( 8 ) :: TINV ! Reciprocal of temperature, /deg K + +C----------------------------------------------------------------------- + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set reciprical of temperatur and mole/cc to ppm conversion factor +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + TINV = 1.0 / TEMP + CFACT = COEF1 * PRES * TINV + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set photolytic rate coefficients using the photolysis J-values that +c are stored in RJBLK +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( .NOT. LSUNLIGHT ) THEN + +c..If dark in every cell, zero all photolysis rate coefficients + DO NRT = 1, NMPHOT + IRXN = IPH( NRT, 1 ) + RK( IRXN ) = 0.0 + END DO + + ELSE + +c..otherwise do all absolute rates first and then relative rates + DO NRT = 1, NMPHOT + IF ( IPH( NRT, 3 ) .NE. 0 ) THEN + IRXN = IPH( NRT, 1 ) + JNUM = IPH( NRT, 2 ) + RK( IRXN ) = RTDAT( 1, IRXN ) * RJIN( JNUM ) + END IF + END DO + + DO NRT = 1, NMPHOT + IF ( IPH( NRT, 3 ) .EQ. 0 ) THEN + IRXN = IPH( NRT, 1 ) + KNUM = IPH( NRT, 2 ) + RK( IRXN ) = RTDAT( 1,IRXN ) * RK( KNUM ) + END IF + END DO + + END IF + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 1: k=A +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN1 + IRXN = KRX1( NRT ) + RK( IRXN ) = RTDAT(1, IRXN ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 2: k=A*(T/300)**B +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN2 + IRXN = KRX2( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * ( TEMP * TI300 ) ** + & RTDAT( 2, IRXN ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 3: k=A*exp(C/T) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN3 + IRXN = KRX3( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * EXP( RTDAT( 3, IRXN ) * TINV ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 4: k=A*((T/300)**B)*exp(C/T) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN4 + IRXN = KRX4( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * ( TEMP * + & TI300 ) ** RTDAT( 2, IRXN ) * + & EXP( RTDAT( 3, IRXN ) * TINV ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 7: k=A*(1+0.6*P) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN7 + IRXN = KRX7( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * ( 1.0 + CONSTC * PRES ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do fall offs and special type %2 (ktype 8) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO 100 NRT = 1, NFALLOFF + + IRXN = IRRFALL( NRT ) + + IF ( KTYPE( IRXN ) .EQ. 8 ) THEN + RK0 = RTDAT( 1, IRXN ) * EXP( RTDAT( 2, IRXN ) * TINV ) + RK2 = RTDAT( 3, IRXN ) * EXP( RFDAT( 1, NRT ) * TINV ) + RK3 = 1.0E+06 * CFACT * RFDAT( 2, NRT ) * + & EXP( RFDAT( 3, NRT ) * TINV ) + RK( IRXN ) = RK0 + ( RK3 / ( 1.0 + RK3 / RK2 ) ) + + ELSE IF ( KTYPE( IRXN ) .EQ. 9 ) THEN + RK1 = RTDAT( 1,IRXN ) * EXP( RTDAT( 2, IRXN ) * TINV ) + RK2 = 1.0E+06 * CFACT * RTDAT( 3,IRXN ) * + & EXP( RFDAT( 1, NRT ) * TINV ) + & + RK( IRXN ) = RK1 + RK2 + + ELSE + RK0 = 1.0E+06 * CFACT * + & RTDAT( 1, IRXN ) * ( TEMP * TI300 ) ** + & RTDAT( 2, IRXN ) * EXP( RTDAT( 3, IRXN ) * TINV ) + RK1 = RFDAT( 1, NRT ) * ( TEMP * TI300 ) ** + & RFDAT( 2, NRT ) * EXP( RFDAT( 3,NRT ) * TINV ) + XEND = 1.0 / (( 1.0 + ( ( 1.0 / RFDAT( 5, NRT ) ) * + & LOG10( RK0 / RK1 ) ) **2 ) ) + RK( IRXN ) = ( RK0 / ( 1.0 + RK0 / RK1 ) ) * + & RFDAT( 4, NRT ) ** XEND + END IF + +100 CONTINUE + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 5 and 6 (multipliers of above reactions) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN5 + IRXN = KRX5( NRT ) + KNUM = INT( RTDAT( 3, IRXN ) ) + RK( IRXN ) = RK( KNUM ) / ( RTDAT( 1,IRXN ) * + & EXP( RTDAT( 2, IRXN ) / TEMP ) ) + END DO + + DO NRT = 1, KTN6 + IRXN = KRX6( NRT ) + KNUM = INT( RTDAT( 2,IRXN ) ) + RK( IRXN ) = RK( KNUM ) * RTDAT( 1, IRXN ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Convert to ppm units as needed +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( KUNITS .EQ. 2 ) THEN + + DO 200 N = 1, NRXNS + IF ( KTYPE( N ) .NE. 0 ) THEN ! Do all non-photolytic reactions + IF ( IORDER( N ) .EQ. 2 ) THEN + RK( N ) = RK( N ) * 60.0 * CFACT + ELSE IF ( IORDER( N ) .EQ. 3 ) THEN + RK( N ) = RK( N ) * 60.0 * CFACT * CFACT + ELSE IF ( IORDER( N ) .EQ. 1 ) THEN + RK( N ) = RK( N ) * 60.0 + ELSE IF ( IORDER( N ) .EQ. 0 ) THEN + RK( N ) = RK( N ) * 60.0 / CFACT + END IF + END IF +200 CONTINUE + + ELSE + + DO 300 N = 1, NFALLOFF ! Do Falloff reactions only + IRXN = IRRFALL( N ) + IF ( IORDER( IRXN ) .EQ. 2 ) THEN + RK( IRXN ) = RK( IRXN ) * 60.0 * CFACT + ELSE IF ( IORDER( IRXN ) .EQ. 3 ) THEN + RK( IRXN ) = RK( IRXN ) * 60.0 * CFACT * CFACT + END IF +300 CONTINUE + + END IF + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Multiply rate constants by [M], [O2], [N2], or [H2O] where needed +c and return +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( NWM .GT. 0 ) THEN + DO NRT = 1, NWM + IRXN = NRXWM( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_AIR + END DO + END IF + + IF ( NWO2 .GT. 0 ) THEN + DO NRT = 1, NWO2 + IRXN = NRXWO2( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_O2 + END DO + END IF + + IF ( NWN2 .GT. 0 ) THEN + DO NRT = 1, NWN2 + IRXN = NRXWN2( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_N2 + END DO + END IF + + IF ( NWW .GT. 0 ) THEN + DO NRT = 1, NWW + IRXN = NRXWW( NRT ) + RK( IRXN ) = RK( IRXN ) * H2O + END DO + END IF + + IF ( NWCH4 .GT. 0 ) THEN + DO NRT = 1, NWCH4 + IRXN = NRXWCH4( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_CH4 + END DO + END IF + + IF ( NWH2 .GT. 0 ) THEN + DO NRT = 1, NWH2 + IRXN = NRXWH2( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_H2 + END DO + END IF + + RETURN + END + diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrdata_mod.F b/models/CCTM/gas/ebi_cb05cl_RN/hrdata_mod.F new file mode 100755 index 0000000..05403e5 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrdata_mod.F @@ -0,0 +1,152 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrdata_mod.F,v 1.3 2011/10/21 16:10:49 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE HRDATA + +C----------------------------------------------------------------------- +C Function: Mechanism & solver data for EBI solver + +C Preconditions: For the CB05CL family of mechanisms + +C Key Subroutines/Functions Called: None + +C Revision History: Created by EBI solver program, Jan. 31, 2008 +C----------------------------------------------------------------------- + +c..EBI solver fixed parameters + INTEGER, PARAMETER :: NEBITER = 1000 ! No. of iterations for EBI + + REAL, PARAMETER :: DELTAT = 2.5D+00 ! EBI time step + +c..Mechanism specific variables + INTEGER N_SPEC ! No. of species in mechanism + INTEGER N_RXNS ! No. of reactions in mechanism + INTEGER N_EBISP ! No. of species solved by EBI + INTEGER NING1 ! No. of species in group 1 + INTEGER NING2 ! No. of species in group 2 + +c..Control flags + LOGICAL L_AE_VRSN ! Flag for aerosol version of mech + LOGICAL L_AQ_VRSN ! Flag for aqueous chemistry version of mech + +c..Miscellaneous variables + INTEGER LOGDEV ! Unit number of output log + INTEGER N_EBI_IT ! No. of iterations for EBI + INTEGER N_EBI_STEPS ! No. of time steps for EBI + INTEGER N_INR_STEPS ! No. of inner time steps for EBI + + REAL EBI_TMSTEP ! Time step for EBI loops (min) + +c...Allocatable arrays + INTEGER, ALLOCATABLE :: EBISP( : ) ! Index of EBI species + + REAL( 8 ), ALLOCATABLE :: RKI ( : ) ! Rate constants + REAL, ALLOCATABLE :: RXRAT( : ) ! Reaction rates + REAL, ALLOCATABLE :: RTOL ( : ) ! Species tolerances + REAL, ALLOCATABLE :: YC ( : ) ! Species concentrations + REAL, ALLOCATABLE :: YC0 ( : ) ! Species concentrations + REAL, ALLOCATABLE :: YCP ( : ) ! Species concentrations + REAL, ALLOCATABLE :: PROD ( : ) ! Prod of species + REAL, ALLOCATABLE :: LOSS ( : ) ! Loss of species + REAL, ALLOCATABLE :: PNEG ( : ) ! Negative production rates + +c..Species indices + INTEGER NO2 + INTEGER NO + INTEGER O + INTEGER O3 + INTEGER NO3 + INTEGER O1D + INTEGER OH + INTEGER HO2 + INTEGER N2O5 + INTEGER HNO3 + INTEGER HONO + INTEGER PNA + INTEGER H2O2 + INTEGER XO2 + INTEGER XO2N + INTEGER NTR + INTEGER ROOH + INTEGER FORM + INTEGER ALD2 + INTEGER ALDX + INTEGER PAR + INTEGER CO + INTEGER MEO2 + INTEGER MEPX + INTEGER MEOH + INTEGER HCO3 + INTEGER FACD + INTEGER C2O3 + INTEGER PAN + INTEGER PACD + INTEGER AACD + INTEGER CXO3 + INTEGER PANX + INTEGER ROR + INTEGER OLE + INTEGER ETH + INTEGER IOLE + INTEGER TOL + INTEGER CRES + INTEGER TO2 + INTEGER TOLRO2 + INTEGER OPEN + INTEGER CRO + INTEGER MGLY + INTEGER XYL + INTEGER XYLRO2 + INTEGER ISOP + INTEGER ISPD + INTEGER ISOPRXN + INTEGER TERP + INTEGER TRPRXN + INTEGER SO2 + INTEGER SULF + INTEGER SULRXN + INTEGER ETOH + INTEGER ETHA + INTEGER CL2 + INTEGER CL + INTEGER HOCL + INTEGER CLO + INTEGER FMCL + INTEGER HCL + INTEGER TOLNRXN + INTEGER TOLHRXN + INTEGER XYLNRXN + INTEGER XYLHRXN + INTEGER BENZENE + INTEGER BENZRO2 + INTEGER BNZNRXN + INTEGER BNZHRXN + INTEGER SESQ + INTEGER SESQRXN + INTEGER RN + + END MODULE HRDATA diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrdriver.F b/models/CCTM/gas/ebi_cb05cl_RN/hrdriver.F new file mode 100755 index 0000000..060e1ce --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrdriver.F @@ -0,0 +1,341 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrdriver.F,v 1.6 2011/10/21 16:10:49 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE CHEM( CGRID, JDATE, JTIME, TSTEP ) + +C----------------------------------------------------------------------- +C Function: Driver subroutine for Euler Backward Iterative solver + +C Preconditions: For the CB05CL family of mechanisms + +C Key Subroutines/Functions Called: HRINIT, PHOT, HRCALCKS, HRSOLVER + +C Revision History: Created by EBI solver program, Jan. 31, 2008 +C Based on the algorithm in "Test of Two Numerical +C Schemes for Use in Atmospheric Transport-Chemistry +C Models", O. Hertel, R. Berkowicz, J. Christensen, +C and O. Hov, Atm Env., Vol. 27A, No. 16, 1993. +C Original MEBI code developed by Ho-Chun Huang, +C SUNY, Albany -- "On the performance of numerical +C solvers for a chemistry submodel in three-dimensional +C air quality models 1. Box model simulations", +C H. Huang and J.S. Chang, JGR, Vol 106, No. D17, 2001. +C This version replaces Huang and Chang use of numerical +C solutions with analytical solutions derived in +C Hertel et al. +C 21 Jun 10 J.Young: convert for Namelist redesign +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C 11 May 11 D.Wong: incorporated twoway model implementation +C----------------------------------------------------------------------- + + USE HGRD_DEFN ! horizontal domain specifications + USE VGRD_DEFN ! vertical layer specifications + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + USE HRDATA + + IMPLICIT NONE + +C..Includes: + INCLUDE SUBST_FILES_ID ! CMAQ files + INCLUDE SUBST_CONST ! CMAQ constants + INCLUDE SUBST_RXCMMN ! Mechanism reaction common block + INCLUDE SUBST_EMISPRM ! Emissions processing control parameters + INCLUDE SUBST_PACTL_ID ! Process analysis control parameters + +C..Arguments: + REAL, POINTER :: CGRID( :,:,:,: ) ! Species concentrations + INTEGER JDATE ! Current date (YYYYDDD) + INTEGER JTIME ! Current time (HHMMSS) + INTEGER TSTEP( 3 ) ! Time step vector (HHMMSS) + +C..Parameters: + REAL, PARAMETER :: PA2ATM = 1.0 / STDATMPA ! Pascal to atm conv fac + +C..External Functions: + +C..Saved Local Variables: + + CHARACTER( 16 ), SAVE :: PNAME = 'HRDRIVER' ! Program name + + INTEGER, SAVE :: ISTFL ! Unit no. of iteration stat output file + LOGICAL, SAVE :: LFIRST = .TRUE. ! Flag for first call to this subroutine + + REAL, SAVE :: MAOMV ! Mol Wt of air over Mol Wt of water + +C..Scratch Local Variables: + CHARACTER( 132 ) :: MSG ! Message text + CHARACTER( 16 ) :: VNAME ! Name of I/O API data variable + + INTEGER C, E, L, R, S ! Loop indices + + INTEGER AVGEBI ! Average no. of EBI iterations + INTEGER DELT_SEC ! EBI max time step in seconds + INTEGER ESP ! Loop index for emissions species + INTEGER ITMSTEP ! Chemistry integration interval (sec) + INTEGER LEV ! Layer index + INTEGER MIDDATE ! Date at time step midpoint + INTEGER MIDTIME ! Time at time step midpoint + INTEGER MNEBI ! Min no. of EBI iterations + INTEGER MXEBI ! Max no. of EBI iterations + INTEGER NDARK ! Number of layer 1 cells in darkness + INTEGER NPH ! Index for number of phot. rxns in PHOT + INTEGER SPC ! Species loop index + INTEGER STATUS ! Status code + INTEGER VAR ! Variable number on I/O API file + + LOGICAL LSUNLIGHT ! Flag for sunlight + + REAL ATMPRES ! Cell pressure + REAL CHEMSTEP ! Chemistry integration interval (min) + REAL H2O ! Cell H2O mixing ratio (ppmV) + REAL SUMEBI ! Sum of EBI iterations + REAL TEMP ! Cell Temperature + + REAL PRES( NCOLS, NROWS, NLAYS ) ! Cell pressure (Pa) + REAL QV( NCOLS, NROWS, NLAYS ) ! Cell water vapor (Kg/Kg air) + REAL TA( NCOLS, NROWS, NLAYS ) ! Cell temperature (K) + REAL RJIN( NPHOTAB ) ! J-values for a cell + REAL RJ( NCOLS, NROWS, NLAYS, NPHOTAB ) ! J-values for each cell + + INTEGER GXOFF, GYOFF ! global origin offset from file +C for INTERPX + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + +C----------------------------------------------------------------------- + + IF ( N_GC_SPC .EQ. 0 ) RETURN + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c On first call, call routines to set-up for EBI solver +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( LFIRST ) THEN + + LOGDEV = INIT3( ) + + IF ( MECHNAME .NE. 'CB05CL_AE5_AQ' .AND. + & MECHNAME .NE. 'CB05CL_AE5CA_AQ' .AND. + & MECHNAME .NE. 'CB05CL_AE5ST_AQ' .AND. + & MECHNAME .NE. 'CB05CL_AE6_AQ' ) THEN + MSG = 'This version of the EBI solver can only be used with' + & // ' the CB05CL chemical mechanisms' + CALL M3EXIT( PNAME, 0, 0, MSG, XSTAT1 ) + END IF + +#ifdef emis_chem + EMISVD = .FALSE. +#else + EMISVD = .TRUE. +#endif + + IF ( INDEX( MECHNAME, 'AE' ) .NE. 0 ) THEN + L_AE_VRSN = .TRUE. + ELSE + L_AE_VRSN = .FALSE. + END IF + + IF ( INDEX( MECHNAME, 'AQ' ) .NE. 0 ) THEN + L_AQ_VRSN = .TRUE. + ELSE + L_AQ_VRSN = .FALSE. + END IF + + IF ( LIRR ) THEN + MSG = 'IRR Analysis not allowed with EBI solver' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + ENDIF + + CALL HRINIT + + ITMSTEP = TIME2SEC( TSTEP( 2 ) ) + CHEMSTEP = FLOAT( ITMSTEP ) / 60.0 + WRITE( LOGDEV, 92000 ) CHEMSTEP, DELTAT + + WRITE( LOGDEV, 92020 ) + DO SPC = 1, N_GC_SPC + WRITE( LOGDEV, 92040 ) GC_SPC( SPC ), RTOL( SPC ) + END DO + + MAOMV = MWAIR / MWWAT + +c..If emissions processing requested stop + IF ( .NOT. EMISVD ) THEN ! assumes emis processing in gas chem + MSG = 'ERROR: EBI solver not configured to '// + & 'process emissions in chemistry' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF ! End if doing emissions + +#ifdef hrstats + ISTFL = JUNIT() + OPEN( UNIT=ISTFL, FILE='iterstat.dat' ) + WRITE( ISTFL, 94020 ) +#endif + + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + LFIRST = .FALSE. + + END IF ! First time + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +C Set date and time to center of time step, get necessary physical +C data, and get photolysis rates +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + MIDDATE = JDATE + MIDTIME = JTIME + ITMSTEP = TIME2SEC( TSTEP( 2 ) ) + CHEMSTEP = FLOAT( ITMSTEP ) / 60.0D+00 + CALL NEXTIME( MIDDATE, MIDTIME, SEC2TIME( ITMSTEP / 2 ) ) + +C.. Compute number of time step loops and step size for EBI solver + DELT_SEC = DELTAT * 60.0 + 0.1 + IF ( DELT_SEC .GE. ITMSTEP ) THEN + N_EBI_STEPS = 1 + EBI_TMSTEP = FLOAT( ITMSTEP ) / 60.0 + ELSE + IF ( MOD( ITMSTEP, DELT_SEC ) .EQ. 0 ) THEN + N_EBI_STEPS = ITMSTEP / DELT_SEC + ELSE + N_EBI_STEPS = ITMSTEP / DELT_SEC + 1 + END IF + EBI_TMSTEP = FLOAT( ITMSTEP ) / FLOAT( N_EBI_STEPS ) / 60.0 + END IF + + N_INR_STEPS = 1 + +C.. Get ambient temperature in K + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MIDDATE, MIDTIME, TA ) ) THEN + MSG = 'Could not read TA from MET_CRO_3D' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + +C.. Get specific humidity in Kg H2O / Kg air + VNAME = 'QV' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MIDDATE, MIDTIME, QV ) ) THEN + MSG = 'Could not read QV from MET_CRO_3D' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + +C.. Get pressure in Pascals + VNAME = 'PRES' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MIDDATE, MIDTIME, PRES ) ) THEN + MSG = 'Could not read PRES from MET_CRO_3D' + CALL M3EXIT ( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + +C.. Get photolysis rates in /min + CALL PHOT ( MIDDATE, MIDTIME, JDATE, JTIME, NDARK, RJ ) + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Top of loop over cells +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +#ifdef hrstats + MNEBI = 1000 + MXEBI = 0 + SUMEBI = 0.0 +#endif + + DO L = 1, NLAYS + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +c..Load ICs + DO S = 1, N_GC_SPC + YC( S ) = MAX( CGRID( C, R, L, S ), 1.0E-30 ) + END DO + +c..Set physical quantities + TEMP = TA( C, R, L ) + ATMPRES = PA2ATM * PRES( C, R, L ) + H2O = MAX ( QV( C, R, L ) * MAOMV * 1.0E+06, 0.0 ) + +c..Get rate constants + LSUNLIGHT = .FALSE. + DO NPH = 1, NPHOTAB + RJIN( NPH ) = RJ( C, R, L, NPH ) + IF ( RJ( C, R, L, NPH ) .GT. 0.0 ) LSUNLIGHT = .TRUE. + ENDDO + + CALL HRCALCKS( NPHOTAB, LSUNLIGHT, RJIN, TEMP, + & ATMPRES, H2O, RKI ) + +c..Call EBI solver + N_EBI_IT = 0 + + CALL HRSOLVER( JDATE, JTIME, C, R, L ) + +#ifdef hrstats + MXEBI = MAX( MXEBI, N_EBI_IT ) + MNEBI = MIN( MNEBI, N_EBI_IT ) + SUMEBI = SUMEBI + FLOAT( N_EBI_IT ) +#endif + +c..Update concentration array + DO S = 1, N_GC_SPC + CGRID( C, R, L, S ) = YC( S ) + END DO + + END DO + END DO + END DO + +#ifdef hrstats + AVGEBI = SUMEBI / FLOAT( NCOLS * NROWS * NLAYS ) + WRITE( ISTFL, 94040 ) JDATE, JTIME, MNEBI, AVGEBI, MXEBI +#endif + + RETURN + +C----------------------- FORMAT STATEMENTS ---------------------------- + +92000 FORMAT( / 10X, 'Euler Backward Iterative Parameters -' + & / 10X, 'Chemistry Integration Time Interval (min):', F12.4, + & / 10X, 'EBI maximum time step (min): ', F12.4 ) + +92020 FORMAT( //10X, 'Species convergence tolerances:' ) + +92040 FORMAT( 10X, A16, 2X, 1PE12.2 ) + +92060 FORMAT( / 10X, 'Emissions Processing in Chemistry ...' + & / 10X, 'Number of Emissions Layers: ', I3 + & / 10X, 'out of total Number of Model Layers:', I3 ) + + +94020 FORMAT( 'DATE TIME ', 'MNEBI AVEBI MXEBI' ) + +94040 FORMAT( I7, 1X, I6, 1X, 3( I5, 1X ) ) + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrg1.F b/models/CCTM/gas/ebi_cb05cl_RN/hrg1.F new file mode 100755 index 0000000..5b96178 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrg1.F @@ -0,0 +1,318 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrg1.F,v 1.2 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG1( DTC ) + +C********************************************************************** +C +C FUNCTION: To solve for the concentration of NO2, NO, O3, and O3P +C algebraically. +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 31, 2008 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C..INCLUDES: None + + +C..ARGUMENTS: + REAL DTC ! Time step + + +C..PARAMETERS: None + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG1' ! Prgram Name + + +C..SCRATCH LOCAL VARIABLES: + REAL O1D_S ! sum of O1D loss frequencies + REAL O3P_S ! stoich coeff for O3P from O1D + + REAL R1_2 ! production term for NO from NO2 + REAL R2_1 ! production term for NO2 from NO + REAL P1, P2, P3, P12 ! production terms for NO, NO2, O3, & O3P + REAL L1, L2, L3, L12 ! loss terms for NO, NO2, O3, O3P + REAL L1_INV, L2_INV, + & L3_INV, L12_INV ! inverse of loss terms + + REAL T1, T2, T3, T4, T5 ! intermerdiate terms + REAL F1, F2, F3 ! intermerdiate terms + REAL A, B, C ! coefficients for quadratic equation + REAL Q, XX, S1, S2 ! intermerdiate terms + + REAL RK1, RK2, RK3 ! rate constants + + REAL PO3 ! temp variable for O3 + +C********************************************************************** + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c O1D Section +c 1) sum of the rate constants for all O1D loss reactions +c 2) get fractional yield of O3P from O1D loss +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + O1D_S = RKI( 10 ) ! O1D=O + & + RKI( 11 ) ! O1D=2*OH + & + RKI( 38 ) ! O1D=OH+HO2 + + O3P_S = RKI( 10 ) ! O1D=O + + O3P_S = O3P_S / O1D_S + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c NO Section +c R1_2 = production of NO from NO2 ( rates of form k[NO2][x] ) +c except NO2+NO3=NO+NO2 (it is treated as if it were NO3=NO ) +c P1 = remaining NO production terms +c L1 = loss of NO (except rxns producing NO2 - they are in R2_1) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + R1_2 = RKI( 1 ) ! NO2=NO+O + & + RKI( 4 ) * YC( O ) ! NO2+O=NO + & + 0.200 * RKI( 156 ) * YC( ISOP ) ! NO2+ISOP=0.2*NO+... + R1_2 = R1_2 * DTC + + + P1 = RXRAT( 15 ) ! NO3=NO + & + RXRAT( 17 ) ! NO2+NO3=NO+NO2 + & + RXRAT( 25 ) ! HONO=NO+OH + & + RXRAT( 27 ) ! HONO+HONO=NO+NO2 + P1 = YC0( NO ) + P1 * DTC + + + L1 = RKI( 23 ) * YC( NO2 ) ! NO+NO2=2*HONO + & + RKI( 24 ) * YC( OH ) ! NO+OH=HONO + & + RKI( 55 ) * YC( XO2N ) ! NO+XO2N=NTR + & + 0.100 * RKI( 129 ) * YC( TO2 ) ! NO+TO2=0.9*NO2+... + L1 = 1.0 + L1 * DTC + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c NO2 Section +c R2_1 = production of NO2 from NO ( rates of form k[NO][x] ) +c a) NO+O3=NO2 not included +c b) NO+NO3=2NO2 ( 1/2 of NO2 formation rate included ) +c c) NO3+NO2=NO+NO2 is not included for NO2 +c P2 = remaining NO2 production terms +c a) NO+O3=NO2 not included +c b) NO+NO3=2NO2 (1/2 of NO2 formation rate included ) +c L2 = loss of NO2 (except rxns producing NO2 - they are in R1_2) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + R2_1 = RKI( 6 ) * YC( O ) ! NO+O=NO2 + & + RKI( 16 ) * YC( NO3 ) ! NO+NO3=2*NO2 + & + 2.000 * RKI( 22 ) * YC( NO ) ! NO+NO=2*NO2 + & + RKI( 30 ) * YC( HO2 ) ! NO+HO2=NO2+OH + & + RKI( 54 ) * YC( XO2 ) ! NO+XO2=NO2 + & + RKI( 67 ) * YC( MEO2 ) ! NO+MEO2=NO2+HO2+FORM + & + RKI( 80 ) * YC( HCO3 ) ! NO+HCO3=NO2+FACD+HO2 + & + RKI( 87 ) * YC( C2O3 ) ! NO+C2O3=NO2+MEO2 + & + RKI( 102 ) * YC( CXO3 ) ! NO+CXO3=NO2+ALD2+... + & + 0.900 * RKI( 129 ) * YC( TO2 ) ! NO+TO2=0.9*NO2+... + & + RKI( 161 ) * YC( CLO ) ! NO+CLO=NO2+CL + R2_1 = R2_1 * DTC + + + P2 = RXRAT( 14 ) ! NO3=NO2+O + & + RXRAT( 16 ) ! NO+NO3=2*NO2 + & + RXRAT( 21 ) ! N2O5=NO2+NO3 + & + RXRAT( 26 ) ! OH+HONO=NO2 + & + RXRAT( 27 ) ! HONO+HONO=NO2+NO + & + RXRAT( 32 ) ! PNA=NO2+HO2 + & + RXRAT( 33 ) ! OH+PNA=NO2 + & + RXRAT( 46 ) ! NO3+O=NO2 + & + RXRAT( 47 ) ! NO3+OH=NO2+HO2 + & + RXRAT( 49 ) ! NO3+O3=NO2 + & + 2.000 * RXRAT( 50 ) ! NO3+NO3=2*NO2 + & + 0.610 * RXRAT( 51 ) ! PNA=0.61*NO2+0.61*HO2+... + & + RXRAT( 52 ) ! HNO3=NO2+OH + & + RXRAT( 53 ) ! N2O5=NO2+NO3 + & + RXRAT( 62 ) ! NTR=NO2+HO2+0.33*FORM+... + & + RXRAT( 89 ) ! PAN=NO2+C2O3 + & + RXRAT( 90 ) ! PAN=NO2+C2O3 + & + RXRAT( 104 ) ! PANX=NO2+CXO3 + & + RXRAT( 105 ) ! PANX=NO2+CXO3 + & + RXRAT( 106 ) ! PANX+OH=NO2+ALD2 + & + RXRAT( 119 ) ! NO3+OLE=NO2+FORM+... + & + RXRAT( 123 ) ! NO3+ETH=NO2+XO2+2*FORM + & + RXRAT( 127 ) ! IOLE+NO3=NO2+... + & + 0.200 * RXRAT( 144 ) ! NO3+ISOP=0.2*NO2+... + & + 0.470 * RXRAT( 152 ) ! TERP+NO3=0.47*NO2+... + P2 = YC0( NO2 ) + P2 * DTC + + + L2 = RKI( 5 ) * YC( O ) ! NO2+O=NO3 + & + RKI( 7 ) * YC( O3 ) ! NO2+O3=NO3 + & + RKI( 18 ) * YC( NO3 ) ! NO2+NO3=N2O5 + & + RKI( 23 ) * YC( NO ) ! NO2+NO=2*HONO + & + RKI( 28 ) * YC( OH ) ! NO2+OH=HNO3 + & + RKI( 31 ) * YC( HO2 ) ! NO2+HO2=PNA + & + RKI( 88 ) * YC( C2O3 ) ! NO2+C2O3=PAN + & + RKI( 103 ) * YC( CXO3 ) ! NO2+CXO3=PANX + & + RKI( 115 ) * YC( ROR ) ! NO2+ROR=NTR + & + RKI( 133 ) * YC( CRO ) ! NO2+CRO=NTR + & + 0.800 * RKI( 156 ) * YC( ISOP ) ! NO2+ISOP=0.2*NO+... + L2 = 1.0 + L2 * DTC + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c O3 Section +c P3 = production of O3 except O+O2=O3 +c L3 = loss terms for O3 except NO+O3=NO2 +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + P3 = 0.200 * RXRAT( 91 ) ! C2O3+HO2=0.2*O3+... + & + 0.200 * RXRAT( 107 ) ! CXO3+HO2=0.2*O3+... + P3 = YC0( O3 ) + P3 * DTC + + + L3 = RKI( 7 ) * YC( NO2 ) ! O3+NO2=NO3 + & + RKI( 8 ) ! O3=O + & + RKI( 9 ) ! O3=O1D + & + RKI( 12 ) * YC( OH ) ! O3+OH=HO2 + & + RKI( 13 ) * YC( HO2 ) ! O3+HO2=OH + & + RKI( 49 ) * YC( NO3 ) ! O3+NO3=NO2 + & + RKI( 118 ) * YC( OLE ) ! O3+OLE=0.18*ALD2+... + & + RKI( 122 ) * YC( ETH ) ! O3+ETH=FORM+... + & + RKI( 126 ) * YC( IOLE ) ! O3+IOLE=... + & + RKI( 137 ) * YC( OPEN ) ! O3+OPEN=... + & + RKI( 143 ) * YC( ISOP ) ! O3+ISOP=... + & + RKI( 146 ) * YC( ISPD ) ! O3+ISPD=... + & + RKI( 151 ) * YC( TERP ) ! O3+TERP=0.57*OH+... + & + RKI( 159 ) * YC( CL ) ! O3+CL=CLO + L3 = 1.0 + L3 * DTC + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c O3P Section +c P12 = production of O3P except NO2+hv=O3P (J1) +c L12 = loss terms +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + P12 = RXRAT( 8 ) ! O3=O + & + O3P_S * RXRAT( 9 ) ! O3=O1D + & + RXRAT( 14 ) ! NO3=O+NO2 + & + RXRAT( 41 ) ! OH+OH=O + & + 0.500 * RXRAT( 126 ) ! IOLE+O3=0.5*O+... + P12 = YC0( O ) + P12 * DTC + + + L12 = RKI( 2 ) ! O=O3 + & + RKI( 4 ) * YC( NO2 ) ! O+NO2=NO + & + RKI( 5 ) * YC( NO2 ) ! O+NO2=NO3 + & + RKI( 6 ) * YC( NO ) ! O+NO=NO2 + & + RKI( 40 ) * YC( OH ) ! O+OH=HO2 + & + RKI( 44 ) * YC( HO2 ) ! O+HO2=OH + & + RKI( 45 ) * YC( H2O2 ) ! O+H2O2=OH+HO2 + & + RKI( 46 ) * YC( NO3 ) ! O+NO3=NO2 + & + RKI( 76 ) * YC( FORM ) ! O+FORM=OH+HO2+CO + & + RKI( 83 ) * YC( ALD2 ) ! O+ALD2=C2O3+OH + & + RKI( 98 ) * YC( ALDX ) ! O+ALDX=CXO3+OH + & + RKI( 116 ) * YC( OLE ) ! O+OLE=0.2*ALD2+... + & + RKI( 120 ) * YC( ETH ) ! O+ETH=FORM+1.7*HO2+CO+... + & + RKI( 124 ) * YC( IOLE ) ! O+IOLE=1.24*ALD2+... + & + RKI( 141 ) * YC( ISOP ) ! O+ISOP=0.75*ISPD+... + & + RKI( 149 ) * YC( TERP ) ! O+TERP=0.15*ALDX+... + L12 = 1.0 + L12 * DTC + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Solution section +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +c..compute reciprocal of loss terms + L1_INV = 1.0 / L1 + L2_INV = 1.0 / L2 + L3_INV = 1.0 / L3 + L12_INV = 1.0 / L12 + +c..compute specific k*delta t terms + RK1 = RKI( 1 ) * DTC ! J1 (NO2+hv=NO+O3P) + RK2 = RKI( 2 ) * DTC ! J2 (O3P+O2=O3) + RK3 = RKI( 3 ) * DTC ! k1_3 (NO+O3=NO2) + +c..compute terms that are used to calulate a,b & c + T1 = RK1 * L2_INV ! J1 / ( 1.0 + Lno2 * dt ) + T2 = R1_2 * L2_INV ! r1,2 / ( 1.0 + Lno2 * dt) + T3 = R2_1 * L1_INV ! r2,1 / ( 1.0 + Lno * dt) + T4 = RK2 * L12_INV ! J2 / ( 1.0 + Lo3p * dt ) + T5 = T3 * P1 - T2 * P2 ! T3 * Pno - T2 * Pno2 + + F1 = 1.0 + T2 + T3 ! factor in calculating a & b + F2 = T1 * T4 ! factor in calculating a & b + F3 = L3 * L1 + RK3 * P1 ! (1 + Lo3 * dt) (1 + lno * dt ) + ! + k1,3 * dt * Pno + + PO3 = P3 + P12 * T4 + + A = RK3 * ( F1 - F2 ) + + B = F1 * F3 + RK3 * ( F2 * ( P2 - P1 ) + PO3 + T5 ) + + C = RK3 * P1 * ( PO3 + P2 * F2 ) + F3 * T5 + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B - 4.0 * A * C ) ) + + XX = MAX( Q / A , C / Q ) + + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Species solutions +c [NO] = ( P1 + x ) / ( 1 + L1 ) +c [NO2] = ( P2 - x ) / ( 1 + L2 ) +c [O3 ] = ( P3 + Ko3p->O3 ) / (1 + K1,3 * [NO] + L3 ) +c [O3P] = ( P12 + J1 * [NO2] ) / ( 1 + L12 ) +c [O1D2] = ( Ko3->o1d * [O3] ) / ( O1D_DNM ) +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + YCP( NO ) = MAX( 0.0, ( P1 + XX ) * L1_INV ) + + YCP( NO2 ) = MAX( 0.0, ( P2 - XX ) * L2_INV ) + + S1 = P12 + RK1 * YCP( NO2 ) + + S2 = T4 * S1 + + YCP( O3 ) = ( P3 + S2 ) / ( L3 + RK3 * YCP( NO ) ) + + YCP( O ) = S1 * L12_INV + + YCP( O1D ) = RKI( 9 ) * YCP( O3 ) / O1D_S + + RETURN + + END + + diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrg2.F b/models/CCTM/gas/ebi_cb05cl_RN/hrg2.F new file mode 100755 index 0000000..afaea13 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrg2.F @@ -0,0 +1,332 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrg2.F,v 1.2 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG2( DTC ) +C********************************************************************** +C +C FUNCTION: To solve for the concentration of HO, HO2, HONO, and +C HNO4 alebraically. +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 31, 2008 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C..INCLUDES: None + + +C..ARGUMENTS: + REAL DTC ! Time step + +C..PARAMETERS: None + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG2' ! Program name + + +C..SCRATCH LOCAL VARIABLES: + REAL O1D_S ! sum of O1D loss frequencies + REAL OH_S ! stoich coeff for OH from O1D+H2O or H2 + REAL HO2_S ! stoich coeff for HO2 from O1D+H2 rxn + REAL R4_19 ! production of OH from HONO + REAL R19_4 ! production of HONO from OH + REAL R4_5 ! production of OH from HO2 + REAL R5_4 ! production of HO2 from OH + REAL R5_21 ! production of HO2 from HNO4 + REAL R21_5 ! production of HNO4 from HO2 + REAL P4, P5, P19, P21 ! species production form other paths + REAL L4, L5, L19, L21 ! species loss terms + + REAL A, B, C ! coeffs of quadratic eq. for HO2 + REAL Q ! intermediate term + + REAL T1, T2, T3 ! intermediate terms + + REAL L21_INV ! reciprocal of HNO4 loss term + +C********************************************************************** + + +c..stoichiometric coefficient for production of HOX from O3 via O1D + O1D_S = RKI( 10 ) ! O1D=O + & + RKI( 11 ) ! O1D=2*OH + & + RKI( 38 ) ! O1D=OH+HO2 + + OH_S = 2.000 * RKI( 11 ) ! O1D=2*OH + & + RKI( 38 ) ! O1D=OH+HO2 + + OH_S = OH_S / O1D_S + + HO2_S = RKI( 38 ) ! O1D=HO2+OH + + HO2_S = HO2_S / O1D_S + +c..Production of HO from HO2 (r4,5 terms ) + R4_5 = RKI( 13 ) * YC( O3 ) ! HO2+O3=OH + & + RKI( 30 ) * YC( NO ) ! HO2+NO=OH+NO2 + & + RKI( 44 ) * YC( O ) ! HO2+O=OH + + R4_5 = R4_5 * DTC + +c..Production of HO from HONO (r4,19 terms ) + R4_19 = RKI( 25 ) ! HONO=OH+NO + + R4_19 = R4_19 * DTC + +c..Remaining HO production + P4 = OH_S * RXRAT( 9 ) ! O1D=2*OH + & + 2.000 * RXRAT( 36 ) ! H2O2=2*OH + & + RXRAT( 45 ) ! H2O2+O=OH+HO2 + & + 0.390 * RXRAT( 51 ) ! PNA=0.39*OH+0.61*HO2+... + & + RXRAT( 52 ) ! HNO3=OH+NO2 + & + RXRAT( 64 ) ! ROOH=OH+HO2+0.5*ALD2+0.5*ALDX + & + RXRAT( 71 ) ! MEPX=OH+HO2+FORM + & + RXRAT( 76 ) ! FORM+O=OH+HO2+CO + & + RXRAT( 83 ) ! ALD2+O=OH+C2O3 + & + RXRAT( 96 ) ! PACD=OH+MEO2 + & + RXRAT( 98 ) ! ALDX+O=OH+CXO3 + & + 0.100 * RXRAT( 116 ) ! O+OLE=0.1*OH+0.3*HO2+... + & + 0.100 * RXRAT( 118 ) ! O3+OLE=0.1*OH+0.44*HO2+... + & + 0.300 * RXRAT( 120 ) ! O+ETH=0.3*OH+1.7*HO2+CO+... + & + 0.130 * RXRAT( 122 ) ! O3+ETH=0.13*OH+0.13*HO2+... + & + 0.500 * RXRAT( 126 ) ! IOLE+O3=0.5*OH+0.5*HO2+... + & + 0.080 * RXRAT( 137 ) ! OPEN+O3=0.08*OH+0.76*HO2+... + & + 0.266 * RXRAT( 143 ) ! O3+ISOP=0.266*OH+0.066*HO2+... + & + 0.268 * RXRAT( 146 ) ! O3+ISPD=0.268*OH+0.154*HO2+... + & + 0.570 * RXRAT( 151 ) ! TERP+O3=0.57*OH+0.07*HO2+... + & + RXRAT( 158 ) ! HOCL=OH+CL + + P4 = YC0( OH ) + P4 * DTC + +c..Production of HO2 from OH ( r5,4 terms ) + R5_4 = RKI( 12 ) * YC( O3 ) ! OH+O3=HO2 + & + RKI( 37 ) * YC( H2O2 ) ! OH+H2O2=HO2 + & + RKI( 39 ) ! OH=HO2 + & + RKI( 40 ) * YC( O ) ! OH+O=HO2 + & + RKI( 47 ) * YC( NO3 ) ! OH+NO3=HO2+NO2 + & + RKI( 61 ) * YC( NTR ) ! OH+NTR=HO2+HNO3+... + & + RKI( 65 ) * YC( CO ) ! OH+CO=HO2 + & + 0.300 * RKI( 70 ) * YC( MEPX ) ! OH+MEPX=0.3*HO2+... + & + RKI( 72 ) * YC( MEOH ) ! OH+MEOH=HO2+FORM + & + RKI( 73 ) * YC( FORM ) ! OH+FORM=HO2+CO + & + RKI( 82 ) * YC( FACD ) ! OH+FACD=HO2 + & + 0.110 * RKI( 112 ) * YC( PAR ) ! OH+PAR=0.11*HO2+... + & + 0.950 * RKI( 117 ) * YC( OLE ) ! OH+OLE=0.95*HO2+... + & + RKI( 121 ) * YC( ETH ) ! OH+ETH=HO2+... + & + RKI( 125 ) * YC( IOLE ) ! OH+IOLE=HO2+... + & + 0.440 * RKI( 128 ) * YC( TOL ) ! OH+TOL=0.44*HO2+... + & + 0.600 * RKI( 131 ) * YC( CRES ) ! OH+CRES=0.6*HO2+... + & + RKI( 136 ) * YC( OPEN ) ! OH+OPEN=2*HO2+... + & + 0.700 * RKI( 138 ) * YC( XYL ) ! OH+XYL=0.7*HO2+... + & + 0.912 * RKI( 142 ) * YC( ISOP ) ! OH+ISOP=... + & + 0.503 * RKI( 145 ) * YC( ISPD ) ! OH+ISPD=... + & + 0.750 * RKI( 150 ) * YC( TERP ) ! OH+TERP=0.75*HO2+... + & + RKI( 153 ) * YC( SO2 ) ! OH+SO2=HO2+SULF+... + & + RKI( 154 ) * YC( ETOH ) ! OH+ETOH=HO2+... + & + RKI( 155 ) * YC( ETHA ) ! OH+ETHA=HO2+... + + R5_4 = R5_4 * DTC + +c..Production of HO2 from HNO4 (r5,21 term ) + R5_21 = RKI( 32 ) ! PNA=HO2+NO2 + & + 0.610 * RKI( 51 ) ! PNA=0.61*HO2+... + + R5_21 = R5_21 * DTC + +c..Remaining HO2 production terms + P5 = HO2_S *RXRAT( 9 ) ! O1D=HO2+OH + & + RXRAT( 45 ) ! H2O2+O=HO2+OH + & + RXRAT( 62 ) ! NTR=HO2+NO2+0.33*FORM+... + & + RXRAT( 64 ) ! ROOH=HO2+OH+0.5*ALD2+0.5*ALDX + & + RXRAT( 67 ) ! MEO2+NO=HO2+FORM+NO2 + & + 0.740 * RXRAT( 69 ) ! MEO2+MEO2=0.74*HO2+... + & + RXRAT( 71 ) ! MEPX=HO2+OH+FORM + & + 2.000 * RXRAT( 74 ) ! FORM=2*HO2+CO + & + RXRAT( 76 ) ! FORM+O=HO2+OH+CO + & + RXRAT( 77 ) ! FORM+NO3=HO2+HNO3+CO + & + RXRAT( 79 ) ! HCO3=HO2+FORM + & + RXRAT( 80 ) ! HCO3+NO=HO2+NO2+FACD + & + RXRAT( 86 ) ! ALD2=HO2+CO+MEO2 + & + 0.900 * RXRAT( 92 ) ! C2O3+MEO2=0.9*HO2+0.9*MEO2+... + & + RXRAT( 101 ) ! ALDX=HO2+CO+MEO2 + & + RXRAT( 102 ) ! CXO3+NO=HO2+NO2+ALD2+XO2 + & + RXRAT( 108 ) ! CXO3+MEO2=HO2+0.9*XO2+... + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*HO2+2*XO2+2*ALD2 + & + RXRAT( 111 ) ! CXO3+C2O3=HO2+XO2+MEO2+ALD2 + & + 0.940 * RXRAT( 113 ) ! ROR=0.94*HO2+0.6*ALD2+... + & + RXRAT( 114 ) ! ROR=HO2 + & + 0.300 * RXRAT( 116 ) ! O+OLE=0.3*HO2+0.1*OH+... + & + 0.440 * RXRAT( 118 ) ! O3+OLE=0.44*HO2+0.1*OH+... + & + 1.700 * RXRAT( 120 ) ! O+ETH=1.7*HO2+0.3*OH+CO+... + & + 0.130 * RXRAT( 122 ) ! O3+ETH=0.13*HO2+0.13*OH+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*HO2+0.66*ALDX+... + & + 0.500 * RXRAT( 126 ) ! IOLE+O3=0.5*HO2+0.5*OH+... + & + RXRAT( 127 ) ! IOLE+NO3=HO2+0.64*ALDX+... + & + 0.900 * RXRAT( 129 ) ! TO2+NO=0.9*HO2+0.9*NO2+... + & + RXRAT( 130 ) ! TO2=HO2+CRES + & + RXRAT( 135 ) ! OPEN=HO2+C2O3+CO + & + RXRAT( 136 ) ! OPEN+OH=2*HO2+2*CO+XO2+... + & + 0.760 * RXRAT( 137 ) ! OPEN+O3=0.76*HO2+0.08*OH+... + & + RXRAT( 140 ) ! MGLY=HO2+C2O3+CO + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*HO2+0.5*FORM+... + & + 0.066 * RXRAT( 143 ) ! O3+ISOP=0.066*HO2+0.266*OH+... + & + 0.800 * RXRAT( 144 ) ! NO3+ISOP=0.8*HO2+0.8*NTR+... + & + 0.154 * RXRAT( 146 ) ! O3+ISPD=0.154*HO2+0.268*OH+... + & + 0.925 * RXRAT( 147 ) ! NO3+ISPD=0.925*HO2+... + & + 1.033 * RXRAT( 148 ) ! ISPD=1.033*HO2+0.067*ALD2+... + & + 0.070 * RXRAT( 151 ) ! TERP+O3=0.07*HO2+0.57*OH+... + & + 0.280 * RXRAT( 152 ) ! TERP+NO3=0.28*HO2+0.47*NO2+... + & + 0.800 * RXRAT( 156 ) ! NO2+ISOP=0.8*HO2+0.8*NTR+... + & + RXRAT( 164 ) ! FMCL=HO2+CO+CL + & + 0.110 * RXRAT( 166 ) ! CL+PAR=0.11*HO2+0.87*XO2+... + & + RXRAT( 167 ) ! CL+ETHA=HO2+0.991*ALD2+... + & + RXRAT( 168 ) ! CL+ETH=HO2+2*XO2+FMCL+FORM + & + RXRAT( 169 ) ! CL+OLE=HO2+0.33*ALD2+... + & + RXRAT( 170 ) ! CL+IOLE=HO2+0.7*FMCL+... + & + RXRAT( 171 ) ! CL+ISOP=HO2+XO2+0.15*HCL+... + & + RXRAT( 172 ) ! CL+FORM=HO2+HCL+CO + & + RXRAT( 175 ) ! CL+MEOH=HO2+HCL+FORM + & + RXRAT( 176 ) ! CL+ETOH=HO2+HCL+ALD2 + + P5 = YC0( HO2 ) + P5 * DTC + +c..Production of HONO from OH (r19,4 terms ) + + R19_4 = RKI( 24 ) * YC( NO ) * DTC ! OH+NO=HONO + +c..Remaining HONO production terms + P19 = 2.000 * RXRAT( 23 ) ! NO+NO2=2*HONO + + P19 = YC0( HONO ) + P19 * DTC + +c..Production of PNA from HO2 (r21,5 term ) + + R21_5 = RKI( 31 ) * YC( NO2 ) * DTC ! HO2+NO2=HNO4 + +c..Remaining PNA production terms + P21 = YC0( PNA ) + +c..OH loss terms not in R5_4 & R19_4 + L4 = RKI( 26 ) * YC( HONO ) ! OH+HONO=NO2 + & + RKI( 28 ) * YC( NO2 ) ! OH+NO2=HNO3 + & + RKI( 29 ) * YC( HNO3 ) ! OH+HNO3=NO3 + & + RKI( 33 ) * YC( PNA ) ! OH+PNA=NO2 + & + 2.000 * RKI( 41 ) * YC( OH ) ! OH+OH=O + & + 2.000 * RKI( 42 ) * YC( OH ) ! OH+OH=H2O2 + & + RKI( 43 ) * YC( HO2 ) ! OH+HO2= + & + RKI( 63 ) * YC( ROOH ) ! OH+ROOH=XO2+... + & + RKI( 66 ) ! OH=MEO2 + & + 0.700 * RKI( 70 ) * YC( MEPX ) ! OH+MEPX=0.3*HO2+... + & + RKI( 84 ) * YC( ALD2 ) ! OH+ALD2=C2O3 + & + RKI( 95 ) * YC( PACD ) ! OH+PACD=C2O3 + & + RKI( 97 ) * YC( AACD ) ! OH+AACD=MEO2 + & + RKI( 99 ) * YC( ALDX ) ! OH+ALDX=CXO3 + & + RKI( 106 ) * YC( PANX ) ! OH+PANX=ALD2+NO2 + & + 0.890 * RKI( 112 ) * YC( PAR ) ! OH+PAR=0.11*HO2+... + & + 0.050 * RKI( 117 ) * YC( OLE ) ! OH+OLE=0.95*HO2+... + & + 0.560 * RKI( 128 ) * YC( TOL ) ! OH+TOL=0.44*HO2+... + & + 0.400 * RKI( 131 ) * YC( CRES ) ! OH+CRES=0.6*HO2+... + & + 0.300 * RKI( 138 ) * YC( XYL ) ! OH+XYL=0.7*HO2+... + & + RKI( 139 ) * YC( MGLY ) ! OH+MGLY=XO2+C2O3 + & + 0.088 * RKI( 142 ) * YC( ISOP ) ! OH+ISOP=... + & + 0.497 * RKI( 145 ) * YC( ISPD ) ! OH+ISPD=... + & + 0.250 * RKI( 150 ) * YC( TERP ) ! OH+TERP=0.75*HO2+... + & + RKI( 163 ) * YC( FMCL ) ! OH+FMCL=CL+CO + & + RKI( 177 ) * YC( HCL ) ! OH+HCL=CL + + L4 = 1.0 + L4 * DTC + R5_4 + R19_4 + +c..HO2 loss terms not included in R4_5 & R21_5 (except for HO2+HO2 ) + L5 = RKI( 43 ) * YC( OH ) ! HO2+OH= + & + RKI( 48 ) * YC( NO3 ) ! HO2+NO3=HNO3 + & + RKI( 56 ) * YC( XO2 ) ! HO2+XO2=ROOH + & + RKI( 57 ) * YC( XO2N ) ! HO2+XO2N=ROOH + & + RKI( 68 ) * YC( MEO2 ) ! HO2+MEO2=MEPX + & + RKI( 78 ) * YC( FORM ) ! HO2+FORM=HCO3 + & + RKI( 81 ) * YC( HCO3 ) ! HO2+HCO3=MEPX + & + RKI( 91 ) * YC( C2O3 ) ! HO2+C2O3=... + & + RKI( 107 ) * YC( CXO3 ) ! HO2+CXO3=... + & + RKI( 134 ) * YC( CRO ) ! HO2+CRO=CRES + & + RKI( 162 ) * YC( CLO ) ! HO2+CLO=HOCL + + L5 = 1.0 + L5 * DTC + R4_5 + R21_5 + +c..HONO loss terms not included in R4_19 + L19 = RKI( 26 ) * YC( OH ) ! HONO+OH=NO2 + & + 2.000 * RKI( 27 ) * YC( HONO ) ! HONO+HONO=NO+NO2 + + L19 = 1.0 + L19 * DTC + R4_19 + +c..PNA loss terms not inluded in R5_21 + L21 = RKI( 33 ) * YC( OH ) ! PNA+OH=NO2 + & + 0.390 * RKI( 51 ) ! PNA=0.61*HO2+... + + L21 = 1.0 + L21 * DTC + R5_21 + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Solution section +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +c..compute terms used to calculate a,b & c + L21_INV = 1.0 / L21 + T1 = 1.0 / ( L4 * L19 - R4_19 * R19_4 ) + T2 = R5_4 * T1 + T3 = R5_21 * L21_INV + +c..solve quadratic equation for HO2 + A = 2.0 * ( RKI( 34 ) + RKI( 35 ) ) * DTC + + B = L5 - T3 * R21_5 - T2 * R4_5 * L19 + + C = P5 + T3 * P21 + T2 * ( P4 * L19 + P19 * R4_19 ) + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B + 4.0 * A * C ) ) + + YCP( HO2 ) = MAX( Q / A , -C / Q ) + +c..compute remaining species concentrations + YCP( OH ) = ( ( P4 + R4_5 * YCP( HO2 ) ) * L19 + R4_19 * P19 ) * T1 + + YCP( PNA ) = ( P21 + R21_5 * YCP( HO2 ) ) * L21_INV + + YCP( HONO ) = ( P19 + R19_4 * YCP( OH ) ) / L19 + + RETURN + + END + + diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrg3.F b/models/CCTM/gas/ebi_cb05cl_RN/hrg3.F new file mode 100755 index 0000000..d89f9f6 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrg3.F @@ -0,0 +1,123 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrg3.F,v 1.2 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG3( DTC ) + +C********************************************************************** +C +C FUNCTION: To solve for the concentration of C2O3 and PAN +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 31, 2008 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + +C..INCLUDES: NONE + +C..ARGUMENTS: + REAL DTC ! Time step + + +C..PARAMETERS: NONE + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG3' ! Program name + + +C..SCRATCH LOCAL VARIABLES: + REAL A, B, C, Q ! Quadratic equation terms + REAL CMN ! Temp scalar + REAL L8 ! Loss of CCO_O2 + REAL L9 ! Loss of PAN + REAL P8 ! Production of CCO_O2 + + REAL K8_8 ! Kc2o3+c2o3 * delta t + REAL R8_9 ! Kpan-->c2o3 * delta t + REAL R9_8 ! Kc2o3+no2-->pan * [NO2] * delta t + +C********************************************************************** + + +c..Production of C2O3 (except from PAN ) + P8 = RXRAT( 83 ) ! ALD2+O=C2O3+OH + & + RXRAT( 84 ) ! ALD2+OH=C2O3 + & + RXRAT( 85 ) ! ALD2+NO3=C2O3+HNO3 + & + RXRAT( 95 ) ! PACD+OH=C2O3 + & + RXRAT( 135 ) ! OPEN=C2O3+HO2+CO + & + RXRAT( 136 ) ! OPEN+OH=C2O3+2*CO+2*HO2+... + & + 0.620 * RXRAT( 137 ) ! OPEN+O3=0.62*C2O3+... + & + RXRAT( 139 ) ! OH+MGLY=C2O3+XO2 + & + RXRAT( 140 ) ! MGLY=C2O3+HO2+CO + & + 0.210 * RXRAT( 145 ) ! OH+ISPD=0.21*C2O3+... + & + 0.114 * RXRAT( 146 ) ! O3+ISPD=0.114*C2O3+... + & + 0.967 * RXRAT( 148 ) ! ISPD=0.967*C2O3+0.067*ALD2+... + & + RXRAT( 173 ) ! CL+ALD2=C2O3+HCL + +c..Loss frequency of C2O3 ( not including C2O3 + C2O3 ) + L8 = RKI( 87 ) * YC( NO ) ! C2O3+NO=MEO2+NO2 + & + RKI( 88 ) * YC( NO2 ) ! C2O3+NO2=PAN + & + RKI( 91 ) * YC( HO2 ) ! C2O3+HO2=... + & + RKI( 92 ) * YC( MEO2 ) ! C2O3+MEO2=... + & + RKI( 93 ) * YC( XO2 ) ! C2O3+XO2=... + & + RKI( 111 ) * YC( CXO3 ) ! C2O3+CXO3=MEO2+... + +c..Loss frequency of PAN + L9 = RKI( 89 ) ! PAN=C2O3+NO2 + & + RKI( 90 ) ! PAN=C2O3+NO2 + +c..K8_8, R8_9, and R9_8 terms + K8_8 = RKI( 94 ) * DTC + + R8_9 = ( RKI( 89 ) + & + RKI( 90 ) ) * DTC + + R9_8 = ( RKI( 88 ) * YC( NO2 ) ) * DTC + +c..Solution of quadratic equation to get C2O3 & PAN + CMN = 1.0 + L9 * DTC + A = 2.0 * K8_8 * CMN + B = CMN * ( 1.0 + L8 * DTC ) - R8_9 * R9_8 + C = CMN * ( YC0( C2O3 ) + P8 * DTC ) + R8_9 * YC0( PAN ) + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B + 4.0 * A * C ) ) + + YCP( C2O3 ) = MAX( Q / A , -C / Q ) + + YCP( PAN ) = ( YC0( PAN ) + R9_8 * YCP( C2O3 ) ) / CMN + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrg4.F b/models/CCTM/gas/ebi_cb05cl_RN/hrg4.F new file mode 100755 index 0000000..e2d92e8 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrg4.F @@ -0,0 +1,130 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrg4.F,v 1.2 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG4( DTC ) + +C********************************************************************** +C +C FUNCTION: To solve for the concentration of NO3 and N2O5 +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 31, 2008 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C..INCLUDES: NONE + + +C..ARGUMENTS: + REAL DTC ! Time step + + +C..PARAMETERS: NONE + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG4' ! Program name + + +C..SCRATCH LOCAL VARIABLES: + REAL A, B, C, Q ! Quadratic equation terms + REAL CMN ! Temp scalar + REAL L15 ! Loss of NO3 + REAL L16 ! Loss of N2O5 + REAL P15 ! Production of NO3 + REAL K15_15 ! Kno3+no3 * delta t + REAL R15_16 ! Kn2o5-->no3 * delta t + REAL R16_15 ! Kno3+no2-->n2o5[NO2] * delta t + + +C********************************************************************** + + +c..Production of NO3 (except from N2O5 ) + P15 = RXRAT( 5 ) ! O+NO2=NO3 + & + RXRAT( 7 ) ! NO2+O3=NO3 + & + RXRAT( 29 ) ! OH+HNO3=NO3 + & + 0.390 * RXRAT( 51 ) ! PNA=0.39*NO3+0.61*NO2+... + +c..Loss frequency of NO3 ( except NO3 + NO3 if present ) + L15 = RKI( 14 ) ! NO3=NO2+O + & + RKI( 15 ) ! NO3=NO + & + RKI( 16 ) * YC( NO ) ! NO3+NO=2*NO2 + & + RKI( 17 ) * YC( NO2 ) ! NO3+NO2=NO+NO2 + & + RKI( 18 ) * YC( NO2 ) ! NO3+NO2=N2O5 + & + RKI( 46 ) * YC( O ) ! NO3+O=NO2 + & + RKI( 47 ) * YC( OH ) ! NO3+OH=HO2+NO2 + & + RKI( 48 ) * YC( HO2 ) ! NO3+HO2=HNO3 + & + RKI( 49 ) * YC( O3 ) ! NO3+O3=NO2 + & + RKI( 77 ) * YC( FORM ) ! NO3+FORM=HNO3+HO2+CO + & + RKI( 85 ) * YC( ALD2 ) ! NO3+ALD2=C2O3+HNO3 + & + RKI( 100 ) * YC( ALDX ) ! NO3+ALDX=CXO3+HNO3 + & + RKI( 119 ) * YC( OLE ) ! NO3+OLE=NO2+FORM+... + & + RKI( 123 ) * YC( ETH ) ! NO3+ETH=NO2+XO2+... + & + RKI( 127 ) * YC( IOLE ) ! NO3+IOLE=... + & + RKI( 132 ) * YC( CRES ) ! NO3+CRES=CRO+HNO3 + & + RKI( 144 ) * YC( ISOP ) ! NO3+ISOP=... + & + RKI( 147 ) * YC( ISPD ) ! NO3+ISPD=... + & + RKI( 152 ) * YC( TERP ) ! NO3+TERP=... + +c..Loss frequency of N2O5 + L16 = RKI( 19 ) ! N2O5=2*HNO3 + & + RKI( 20 ) ! N2O5=2*HNO3 + & + RKI( 21 ) ! N2O5=NO3+NO2 + & + RKI( 53 ) ! N2O5=NO2+NO3 + +c..K15_15, R15_16, and R16_15 terms + K15_15 = RKI( 50 ) * DTC + + R15_16 = ( RKI( 21 ) + & + RKI( 53 ) ) * DTC + + + R16_15 = RKI( 18 ) * YC( NO2 ) * DTC + +c..Solution of quadratic equation to get NO3 & N2O5 + CMN = 1.0 + L16 * DTC + A = 2.0 * K15_15 * CMN + B = CMN * ( 1.0 + L15 * DTC ) - R15_16 * R16_15 + C = CMN * ( YC0( NO3 ) + P15 * DTC ) + R15_16 * YC0( N2O5 ) + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B + 4.0 * A * C ) ) + YCP( NO3 ) = MAX( Q / A , -C / Q ) + YCP( N2O5 ) = ( YC0( N2O5 ) + R16_15 * YCP( NO3 ) ) / CMN + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrinit.F b/models/CCTM/gas/ebi_cb05cl_RN/hrinit.F new file mode 100755 index 0000000..d5261ed --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrinit.F @@ -0,0 +1,314 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrinit.F,v 1.4 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HRINIT + +C----------------------------------------------------------------------- +C Function: To initialize species tolerances, arrays, and indices + +C Preconditions: For the CB05CL family of mechanisms + +C Return Values: None + +C Key Subroutines/Functions Called: None + +C Revision History: Created by EBI solver program, Jan. 31, 2008 +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE CGRID_SPCS, ONLY: N_GC_SPC ! CGRID mechanism species + USE UTILIO_DEFN + USE HRDATA + + IMPLICIT NONE + +C.....Includes: + INCLUDE SUBST_RXCMMN ! Mechanism reaction common block + +C.....Arguments: NONE + +C.....Parameters: NONE + +C.....External Functions: + INTEGER FINDEX ! Finds location of a number in a list + +C.....Saved Variables: + CHARACTER( 16 ), SAVE :: PNAME = 'HRINIT' ! Program name + +C.....Local Variables: + CHARACTER( 132 ) :: MSG = ' ' ! Log message + + INTEGER IND ! Species index + INTEGER N ! Loop index + INTEGER IOS ! Allocate error status + +C----------------------------------------------------------------------- + + N_SPEC = N_GC_SPC + N_RXNS = NRXNS + + ALLOCATE( RKI( NRXNS ), + & RXRAT( NRXNS ), + & RTOL( N_SPEC), + & YC( N_SPEC), + & YC0( N_SPEC), + & YCP( N_SPEC), + & PROD( N_SPEC), + & LOSS( N_SPEC), + & PNEG( N_SPEC), STAT = IOS ) + IF ( IOS .NE. 0 ) THEN + MSG = 'Error allocating RKI, RXRAT, RTOL, YC, YC0, YCP, PROD, LOSS, or PNEG' + CALL M3EXIT( PNAME, 0, 0, MSG, XSTAT1 ) + END IF + + NING1 = 4 + NING2 = 4 + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set species indices and pointers +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + NO2 = 1 + NO = 2 + O = 3 + O3 = 4 + NO3 = 5 + O1D = 6 + OH = 7 + HO2 = 8 + N2O5 = 9 + HNO3 = 10 + HONO = 11 + PNA = 12 + H2O2 = 13 + XO2 = 14 + XO2N = 15 + NTR = 16 + ROOH = 17 + FORM = 18 + ALD2 = 19 + ALDX = 20 + PAR = 21 + CO = 22 + MEO2 = 23 + MEPX = 24 + MEOH = 25 + HCO3 = 26 + FACD = 27 + C2O3 = 28 + PAN = 29 + PACD = 30 + AACD = 31 + CXO3 = 32 + PANX = 33 + ROR = 34 + OLE = 35 + ETH = 36 + IOLE = 37 + TOL = 38 + CRES = 39 + TO2 = 40 + TOLRO2 = 41 + OPEN = 42 + CRO = 43 + MGLY = 44 + XYL = 45 + XYLRO2 = 46 + ISOP = 47 + ISPD = 48 + ISOPRXN = 49 + TERP = 50 + TRPRXN = 51 + SO2 = 52 + SULF = 53 + SULRXN = 54 + ETOH = 55 + ETHA = 56 + RN = 57 + CL2 = 58 + CL = 59 + HOCL = 60 + CLO = 61 + FMCL = 62 + HCL = 63 + TOLNRXN = 64 + TOLHRXN = 65 + XYLNRXN = 66 + XYLHRXN = 67 + BENZENE = 68 + BENZRO2 = 69 + BNZNRXN = 70 + BNZHRXN = 71 + SESQ = 72 + SESQRXN = 73 + + N_EBISP = 60 + ALLOCATE( EBISP( N_EBISP ), STAT = IOS ) + IF ( IOS .NE. 0 ) THEN + MSG = 'Error allocating EBISP' + CALL M3EXIT( PNAME, 0, 0, MSG, XSTAT1 ) + END IF + + EBISP( 1 ) = HNO3 + EBISP( 2 ) = H2O2 + EBISP( 3 ) = XO2 + EBISP( 4 ) = XO2N + EBISP( 5 ) = NTR + EBISP( 6 ) = ROOH + EBISP( 7 ) = FORM + EBISP( 8 ) = ALD2 + EBISP( 9 ) = ALDX + EBISP( 10 ) = PAR + EBISP( 11 ) = CO + EBISP( 12 ) = MEO2 + EBISP( 13 ) = MEPX + EBISP( 14 ) = MEOH + EBISP( 15 ) = HCO3 + EBISP( 16 ) = FACD + EBISP( 17 ) = PACD + EBISP( 18 ) = AACD + EBISP( 19 ) = CXO3 + EBISP( 20 ) = PANX + EBISP( 21 ) = ROR + EBISP( 22 ) = OLE + EBISP( 23 ) = ETH + EBISP( 24 ) = IOLE + EBISP( 25 ) = TOL + EBISP( 26 ) = CRES + EBISP( 27 ) = TO2 + EBISP( 28 ) = TOLRO2 + EBISP( 29 ) = OPEN + EBISP( 30 ) = CRO + EBISP( 31 ) = MGLY + EBISP( 32 ) = XYL + EBISP( 33 ) = XYLRO2 + EBISP( 34 ) = ISOP + EBISP( 35 ) = ISPD + EBISP( 36 ) = ISOPRXN + EBISP( 37 ) = TERP + EBISP( 38 ) = TRPRXN + EBISP( 39 ) = SO2 + EBISP( 40 ) = SULF + EBISP( 41 ) = SULRXN + EBISP( 42 ) = ETOH + EBISP( 43 ) = ETHA + EBISP( 44 ) = RN + EBISP( 45 ) = CL2 + EBISP( 46 ) = CL + EBISP( 47 ) = HOCL + EBISP( 48 ) = CLO + EBISP( 49 ) = FMCL + EBISP( 50 ) = HCL + EBISP( 51 ) = TOLNRXN + EBISP( 52 ) = TOLHRXN + EBISP( 53 ) = XYLNRXN + EBISP( 54 ) = XYLHRXN + EBISP( 55 ) = BENZENE + EBISP( 56 ) = BENZRO2 + EBISP( 57 ) = BNZNRXN + EBISP( 58 ) = BNZHRXN + EBISP( 59 ) = SESQ + EBISP( 60 ) = SESQRXN + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set species tolerances +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + RTOL( NO2 ) = 1.0E-03 + RTOL( NO ) = 1.0E-03 + RTOL( O ) = 1.0E+00 + RTOL( O3 ) = 1.0E-03 + RTOL( NO3 ) = 1.0E-03 + RTOL( O1D ) = 1.0E+00 + RTOL( OH ) = 1.0E-03 + RTOL( HO2 ) = 1.0E-03 + RTOL( N2O5 ) = 1.0E-03 + RTOL( HNO3 ) = 1.0E-03 + RTOL( HONO ) = 1.0E-03 + RTOL( PNA ) = 1.0E-03 + RTOL( H2O2 ) = 1.0E-03 + RTOL( XO2 ) = 1.0E-03 + RTOL( XO2N ) = 1.0E-03 + RTOL( NTR ) = 1.0E+00 + RTOL( ROOH ) = 1.0E-03 + RTOL( FORM ) = 1.0E-03 + RTOL( ALD2 ) = 1.0E-03 + RTOL( ALDX ) = 1.0E-03 + RTOL( PAR ) = 1.0E-03 + RTOL( CO ) = 1.0E-03 + RTOL( MEO2 ) = 1.0E-03 + RTOL( MEPX ) = 1.0E-03 + RTOL( MEOH ) = 1.0E-03 + RTOL( HCO3 ) = 1.0E+00 + RTOL( FACD ) = 1.0E-03 + RTOL( C2O3 ) = 1.0E-03 + RTOL( PAN ) = 1.0E-03 + RTOL( PACD ) = 1.0E-03 + RTOL( AACD ) = 1.0E-03 + RTOL( CXO3 ) = 1.0E-03 + RTOL( PANX ) = 1.0E-03 + RTOL( ROR ) = 1.0E-03 + RTOL( OLE ) = 1.0E-03 + RTOL( ETH ) = 1.0E-03 + RTOL( IOLE ) = 1.0E-03 + RTOL( TOL ) = 1.0E-03 + RTOL( CRES ) = 1.0E-03 + RTOL( TO2 ) = 1.0E-03 + RTOL( TOLRO2 ) = 1.0E-03 + RTOL( OPEN ) = 1.0E-03 + RTOL( CRO ) = 1.0E-03 + RTOL( MGLY ) = 1.0E-03 + RTOL( XYL ) = 1.0E-03 + RTOL( XYLRO2 ) = 1.0E-03 + RTOL( ISOP ) = 1.0E-03 + RTOL( ISPD ) = 1.0E-03 + RTOL( ISOPRXN ) = 1.0E+00 + RTOL( TERP ) = 1.0E-03 + RTOL( TRPRXN ) = 1.0E+00 + RTOL( SO2 ) = 1.0E-03 + RTOL( SULF ) = 1.0E+00 + RTOL( SULRXN ) = 1.0E+00 + RTOL( ETOH ) = 1.0E-03 + RTOL( ETHA ) = 1.0E-03 + RTOL( RN ) = 1.0E-03 + RTOL( CL2 ) = 1.0E-03 + RTOL( CL ) = 1.0E-03 + RTOL( HOCL ) = 1.0E-03 + RTOL( CLO ) = 1.0E-03 + RTOL( FMCL ) = 1.0E-03 + RTOL( HCL ) = 1.0E-03 + RTOL( TOLNRXN ) = 1.0E+00 + RTOL( TOLHRXN ) = 1.0E+00 + RTOL( XYLNRXN ) = 1.0E+00 + RTOL( XYLHRXN ) = 1.0E+00 + RTOL( BENZENE ) = 1.0E-03 + RTOL( BENZRO2 ) = 1.0E-03 + RTOL( BNZNRXN ) = 1.0E+00 + RTOL( BNZHRXN ) = 1.0E+00 + RTOL( SESQ ) = 1.0E-03 + RTOL( SESQRXN ) = 1.0E+00 + + RETURN + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrprodloss.F b/models/CCTM/gas/ebi_cb05cl_RN/hrprodloss.F new file mode 100755 index 0000000..4c015f6 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrprodloss.F @@ -0,0 +1,629 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrprodloss.F,v 1.2 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRPRODLOSS + +C*********************************************************************** +C +C FUNCTION: To compute the production and loss rates for EBI species +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C RETURN VALUES: None +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, April 1, 2008 +C +C*********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C.....INCLUDES: NONE + + +C.....ARGUMENTS: NONE + + +C.....PARAMETERS: NONE + + +C.....EXTERNAL FUNCTIONS: NONE + + +C.....SAVED VARIABLES: NONE + CHARACTER( 16 ), SAVE :: PNAME = 'HRPRODLOSS' ! Program name + + +C.....LOCAL VARIABLES: + + INTEGER ESP + +C*********************************************************************** + + + PROD( HNO3 ) = 2.000 * RXRAT( 19 ) ! N2O5=2*HNO3 + & + 2.000 * RXRAT( 20 ) ! N2O5=2*HNO3 + & + RXRAT( 28 ) ! NO2+OH=HNO3 + & + RXRAT( 48 ) ! NO3+HO2=HNO3 + & + RXRAT( 61 ) ! NTR+OH=HNO3+HO2+0.33*FORM+... + & + RXRAT( 77 ) ! FORM+NO3=HNO3+HO2+CO + & + RXRAT( 85 ) ! ALD2+NO3=HNO3+C2O3 + & + RXRAT( 100 ) ! ALDX+NO3=HNO3+CXO3 + & + RXRAT( 132 ) ! CRES+NO3=HNO3+CRO + & + 0.150 * RXRAT( 147 ) ! NO3+ISPD=0.15*HNO3+... + LOSS( HNO3 ) = RXRAT( 29 ) ! HNO3+OH=NO3 + & + RXRAT( 52 ) ! HNO3=OH+NO2 + + PROD( H2O2 ) = RXRAT( 34 ) ! HO2+HO2=H2O2 + & + RXRAT( 35 ) ! HO2+HO2=H2O2 + & + RXRAT( 42 ) ! OH+OH=H2O2 + LOSS( H2O2 ) = RXRAT( 36 ) ! H2O2=2*OH + & + RXRAT( 37 ) ! H2O2+OH=HO2 + & + RXRAT( 45 ) ! H2O2+O=OH+HO2 + + PROD( XO2 ) = RXRAT( 63 ) ! ROOH+OH=XO2+0.5*ALD2+0.5*ALDX + & + 0.300 * RXRAT( 70 ) ! MEPX+OH=0.3*XO2+0.7*MEO2+... + & + RXRAT( 102 ) ! CXO3+NO=XO2+NO2+HO2+ALD2 + & + 0.900 * RXRAT( 108 ) ! CXO3+MEO2=0.9*XO2+0.9*ALD2+... + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*XO2+2*ALD2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=XO2+MEO2+HO2+ALD2 + & + 0.870 * RXRAT( 112 ) ! PAR+OH=0.87*XO2+0.13*XO2N+... + & + 0.960 * RXRAT( 113 ) ! ROR=0.96*XO2+0.6*ALD2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*XO2+0.3*ALDX+... + & + 0.800 * RXRAT( 117 ) ! OH+OLE=0.8*XO2+0.33*ALD2+... + & + 0.220 * RXRAT( 118 ) ! O3+OLE=0.22*XO2+0.74*FORM+... + & + 0.910 * RXRAT( 119 ) ! NO3+OLE=0.91*XO2+FORM+NO2+... + & + 0.700 * RXRAT( 120 ) ! O+ETH=0.7*XO2+1.7*HO2+CO+... + & + RXRAT( 121 ) ! OH+ETH=XO2+1.56*FORM+... + & + RXRAT( 123 ) ! NO3+ETH=XO2+NO2+2*FORM + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*XO2+0.66*ALDX+... + & + RXRAT( 125 ) ! IOLE+OH=XO2+0.7*ALDX+HO2+... + & + 0.080 * RXRAT( 128 ) ! TOL+OH=0.08*XO2+0.44*HO2+... + & + 0.600 * RXRAT( 131 ) ! OH+CRES=0.6*XO2+0.4*CRO+... + & + RXRAT( 136 ) ! OPEN+OH=XO2+2*CO+2*HO2+... + & + 0.030 * RXRAT( 137 ) ! OPEN+O3=0.03*XO2+0.62*C2O3+... + & + 0.500 * RXRAT( 138 ) ! OH+XYL=0.5*XO2+0.7*HO2+... + & + RXRAT( 139 ) ! OH+MGLY=XO2+C2O3 + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*XO2+0.5*FORM+... + & + 0.991 * RXRAT( 142 ) ! OH+ISOP=0.991*XO2+... + & + 0.200 * RXRAT( 143 ) ! O3+ISOP=0.2*XO2+0.6*FORM+... + & + RXRAT( 144 ) ! NO3+ISOP=XO2+0.8*NTR+... + & + 0.713 * RXRAT( 145 ) ! OH+ISPD=0.713*XO2+... + & + 0.064 * RXRAT( 146 ) ! O3+ISPD=0.064*XO2+... + & + 0.075 * RXRAT( 147 ) ! NO3+ISPD=0.075*XO2+... + & + 0.700 * RXRAT( 148 ) ! ISPD=0.7*XO2+0.067*ALD2+... + & + 1.250 * RXRAT( 150 ) ! TERP+OH=1.25*XO2+0.75*HO2+... + & + 0.760 * RXRAT( 151 ) ! TERP+O3=0.76*XO2+0.07*HO2+... + & + 1.030 * RXRAT( 152 ) ! TERP+NO3=1.03*XO2+0.28*HO2+... + & + 0.100 * RXRAT( 154 ) ! OH+ETOH=0.1*XO2+0.9*ALD2+... + & + 0.991 * RXRAT( 155 ) ! OH+ETHA=0.991*XO2+... + & + RXRAT( 156 ) ! NO2+ISOP=XO2+0.8*NTR+... + & + 0.870 * RXRAT( 167 ) ! CL+PAR=0.87*XO2+HCL+... + & + 0.991 * RXRAT( 168 ) ! CL+ETHA=0.991*XO2+... + & + 2.000 * RXRAT( 169 ) ! CL+ETH=2*XO2+FMCL+HO2+FORM + & + 2.000 * RXRAT( 170 ) ! CL+OLE=2*XO2+0.33*ALD2+... + & + 1.700 * RXRAT( 171 ) ! CL+IOLE=1.7*XO2+0.7*FMCL+... + & + RXRAT( 172 ) ! CL+ISOP=XO2+0.15*HCL+HO2+... + LOSS( XO2 ) = RXRAT( 54 ) ! XO2+NO=NO2 + & + RXRAT( 56 ) ! XO2+HO2=ROOH + & + 2.000 * RXRAT( 58 ) ! XO2+XO2= + & + RXRAT( 60 ) ! XO2+XO2N= + & + RXRAT( 93 ) ! XO2+C2O3=0.9*MEO2+0.1*AACD + & + RXRAT( 109 ) ! XO2+CXO3=0.9*ALD2+0.1*AACD + + PROD( XO2N ) = 0.130 * RXRAT( 112 ) ! PAR+OH=0.13*XO2N+0.87*XO2+... + & + 0.040 * RXRAT( 113 ) ! ROR=0.04*XO2N+0.6*ALD2+... + & + 0.010 * RXRAT( 116 ) ! O+OLE=0.01*XO2N+0.3*ALDX+... + & + 0.090 * RXRAT( 119 ) ! NO3+OLE=0.09*XO2N+FORM+... + & + 0.088 * RXRAT( 142 ) ! OH+ISOP=0.088*XO2N+... + & + 0.250 * RXRAT( 150 ) ! TERP+OH=0.25*XO2N+1.25*XO2+... + & + 0.181 * RXRAT( 151 ) ! TERP+O3=0.18*XO2N+0.07*HO2+... + & + 0.250 * RXRAT( 152 ) ! TERP+NO3=0.25*XO2N+... + & + 0.009 * RXRAT( 155 ) ! OH+ETHA=0.009*XO2N+... + & + 0.130 * RXRAT( 167 ) ! CL+PAR=0.13*XO2N+0.87*XO2+... + & + 0.009 * RXRAT( 168 ) ! CL+ETHA=0.009*XO2N+... + LOSS( XO2N ) = RXRAT( 55 ) ! XO2N+NO=NTR + & + RXRAT( 57 ) ! XO2N+HO2=ROOH + & + 2.000 * RXRAT( 59 ) ! XO2N+XO2N= + & + RXRAT( 60 ) ! XO2N+XO2= + + PROD( NTR ) = RXRAT( 55 ) ! XO2N+NO=NTR + & + RXRAT( 115 ) ! ROR+NO2=NTR + & + 0.100 * RXRAT( 129 ) ! TO2+NO=0.1*NTR+0.9*HO2+... + & + RXRAT( 133 ) ! CRO+NO2=NTR + & + 0.800 * RXRAT( 144 ) ! NO3+ISOP=0.8*NTR+0.2*ISPD+... + & + 0.850 * RXRAT( 147 ) ! NO3+ISPD=0.85*NTR+... + & + 0.530 * RXRAT( 152 ) ! TERP+NO3=0.53*NTR+0.28*HO2+... + & + 0.800 * RXRAT( 156 ) ! NO2+ISOP=0.8*NTR+0.2*ISPD+... + LOSS( NTR ) = RXRAT( 61 ) ! NTR+OH=HNO3+HO2+0.33*FORM+... + & + RXRAT( 62 ) ! NTR=NO2+HO2+0.33*FORM+... + + PROD( ROOH ) = RXRAT( 56 ) ! XO2+HO2=ROOH + & + RXRAT( 57 ) ! XO2N+HO2=ROOH + LOSS( ROOH ) = RXRAT( 63 ) ! ROOH+OH=XO2+0.5*ALD2+0.5*ALDX + & + RXRAT( 64 ) ! ROOH=OH+HO2+0.5*ALD2+0.5*ALDX + + PROD( FORM ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*FORM+HO2+HNO3+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*FORM+HO2+NO2+... + & + RXRAT( 67 ) ! MEO2+NO=FORM+HO2+NO2 + & + 1.370 * RXRAT( 69 ) ! MEO2+MEO2=1.37*FORM+... + & + RXRAT( 71 ) ! MEPX=FORM+HO2+OH + & + RXRAT( 72 ) ! MEOH+OH=FORM+HO2 + & + RXRAT( 79 ) ! HCO3=FORM+HO2 + & + RXRAT( 92 ) ! C2O3+MEO2=FORM+0.9*HO2+... + & + 0.100 * RXRAT( 108 ) ! CXO3+MEO2=0.1*FORM+0.9*XO2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*FORM+0.3*ALDX+... + & + 0.800 * RXRAT( 117 ) ! OH+OLE=0.8*FORM+0.33*ALD2+... + & + 0.740 * RXRAT( 118 ) ! O3+OLE=0.74*FORM+0.18*ALD2+... + & + RXRAT( 119 ) ! NO3+OLE=FORM+NO2+0.91*XO2+... + & + RXRAT( 120 ) ! O+ETH=FORM+1.7*HO2+CO+... + & + 1.560 * RXRAT( 121 ) ! OH+ETH=1.56*FORM+XO2+... + & + RXRAT( 122 ) ! O3+ETH=FORM+0.63*CO+... + & + 2.000 * RXRAT( 123 ) ! NO3+ETH=2*FORM+XO2+NO2 + & + 0.250 * RXRAT( 126 ) ! IOLE+O3=0.25*FORM+... + & + RXRAT( 136 ) ! OPEN+OH=FORM+2*CO+2*HO2+... + & + 0.700 * RXRAT( 137 ) ! OPEN+O3=0.7*FORM+0.62*C2O3+... + & + 0.500 * RXRAT( 141 ) ! O+ISOP=0.5*FORM+0.75*ISPD+... + & + 0.629 * RXRAT( 142 ) ! OH+ISOP=0.629*FORM+... + & + 0.600 * RXRAT( 143 ) ! O3+ISOP=0.6*FORM+0.65*ISPD+... + & + 0.168 * RXRAT( 145 ) ! OH+ISPD=0.168*FORM+... + & + 0.150 * RXRAT( 146 ) ! O3+ISPD=0.15*FORM+... + & + 0.282 * RXRAT( 147 ) ! NO3+ISPD=0.282*FORM+... + & + 0.900 * RXRAT( 148 ) ! ISPD=0.9*FORM+0.067*ALD2+... + & + 0.280 * RXRAT( 150 ) ! TERP+OH=0.28*FORM+1.25*XO2+... + & + 0.240 * RXRAT( 151 ) ! TERP+O3=0.24*FORM+0.07*HO2+... + & + 0.100 * RXRAT( 154 ) ! OH+ETOH=0.1*FORM+0.9*ALD2+... + & + RXRAT( 169 ) ! CL+ETH=FORM+2*XO2+HO2+FMCL + & + RXRAT( 176 ) ! CL+MEOH=FORM+HO2+HCL + LOSS( FORM ) = RXRAT( 73 ) ! FORM+OH=HO2+CO + & + RXRAT( 74 ) ! FORM=2*HO2+CO + & + RXRAT( 75 ) ! FORM=CO + & + RXRAT( 76 ) ! FORM+O=OH+HO2+CO + & + RXRAT( 77 ) ! FORM+NO3=HNO3+HO2+CO + & + RXRAT( 78 ) ! FORM+HO2=HCO3 + & + RXRAT( 173 ) ! FORM+CL=HCL+HO2+CO + + PROD( ALD2 ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*ALD2+HO2+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*ALD2+HO2+... + & + 0.500 * RXRAT( 63 ) ! ROOH+OH=0.5*ALD2+XO2+0.5*ALDX + & + 0.500 * RXRAT( 64 ) ! ROOH=0.5*ALD2+HO2+OH+0.5*ALDX + & + RXRAT( 102 ) ! CXO3+NO=ALD2+NO2+HO2+XO2 + & + RXRAT( 106 ) ! PANX+OH=ALD2+NO2 + & + 0.900 * RXRAT( 108 ) ! CXO3+MEO2=0.9*ALD2+0.9*XO2+... + & + 0.900 * RXRAT( 109 ) ! CXO3+XO2=0.9*ALD2+0.1*AACD + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*ALD2+2*XO2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=ALD2+XO2+HO2+MEO2 + & + 0.060 * RXRAT( 112 ) ! PAR+OH=0.06*ALD2+0.13*XO2N+... + & + 0.600 * RXRAT( 113 ) ! ROR=0.6*ALD2+0.96*XO2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*ALD2+0.3*ALDX+... + & + 0.330 * RXRAT( 117 ) ! OH+OLE=0.33*ALD2+0.8*FORM+... + & + 0.181 * RXRAT( 118 ) ! O3+OLE=0.18*ALD2+0.74*FORM+... + & + 0.350 * RXRAT( 119 ) ! NO3+OLE=0.35*ALD2+FORM+... + & + 1.240 * RXRAT( 124 ) ! IOLE+O=1.24*ALD2+0.66*ALDX+... + & + 1.300 * RXRAT( 125 ) ! IOLE+OH=1.3*ALD2+0.7*ALDX+... + & + 0.650 * RXRAT( 126 ) ! IOLE+O3=0.65*ALD2+... + & + 1.181 * RXRAT( 127 ) ! IOLE+NO3=1.18*ALD2+... + & + 0.252 * RXRAT( 145 ) ! OH+ISPD=0.252*ALD2+... + & + 0.020 * RXRAT( 146 ) ! O3+ISPD=0.02*ALD2+... + & + 0.067 * RXRAT( 148 ) ! ISPD=0.067*ALD2+0.333*CO+... + & + 0.900 * RXRAT( 154 ) ! OH+ETOH=0.9*ALD2+HO2+... + & + 0.991 * RXRAT( 155 ) ! OH+ETHA=0.991*ALD2+... + & + 0.060 * RXRAT( 167 ) ! CL+PAR=0.06*ALD2+0.87*XO2+... + & + 0.991 * RXRAT( 168 ) ! CL+ETHA=0.991*ALD2+HCL+... + & + 0.330 * RXRAT( 170 ) ! CL+OLE=0.33*ALD2+FMCL+... + & + 0.450 * RXRAT( 171 ) ! CL+IOLE=0.45*ALD2+0.7*FMCL+... + & + RXRAT( 177 ) ! CL+ETOH=ALD2+HO2+HCL + LOSS( ALD2 ) = RXRAT( 83 ) ! ALD2+O=C2O3+OH + & + RXRAT( 84 ) ! ALD2+OH=C2O3 + & + RXRAT( 85 ) ! ALD2+NO3=C2O3+HNO3 + & + RXRAT( 86 ) ! ALD2=MEO2+CO+HO2 + & + RXRAT( 174 ) ! ALD2+CL=HCL+C2O3 + + PROD( ALDX ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*ALDX+HO2+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*ALDX+HO2+... + & + 0.500 * RXRAT( 63 ) ! ROOH+OH=0.5*ALDX+0.5*ALD2+XO2 + & + 0.500 * RXRAT( 64 ) ! ROOH=0.5*ALDX+HO2+0.5*ALD2+OH + & + 0.050 * RXRAT( 112 ) ! PAR+OH=0.05*ALDX+0.13*XO2N+... + & + 0.500 * RXRAT( 113 ) ! ROR=0.5*ALDX+0.6*ALD2+... + & + 0.300 * RXRAT( 116 ) ! O+OLE=0.3*ALDX+0.2*ALD2+... + & + 0.620 * RXRAT( 117 ) ! OH+OLE=0.62*ALDX+0.33*ALD2+... + & + 0.320 * RXRAT( 118 ) ! O3+OLE=0.32*ALDX+0.74*FORM+... + & + 0.560 * RXRAT( 119 ) ! NO3+OLE=0.56*ALDX+FORM+... + & + 0.220 * RXRAT( 121 ) ! OH+ETH=0.22*ALDX+1.56*FORM+... + & + 0.660 * RXRAT( 124 ) ! IOLE+O=0.66*ALDX+1.24*ALD2+... + & + 0.700 * RXRAT( 125 ) ! IOLE+OH=0.7*ALDX+1.3*ALD2+... + & + 0.350 * RXRAT( 126 ) ! IOLE+O3=0.35*ALDX+... + & + 0.640 * RXRAT( 127 ) ! IOLE+NO3=0.64*ALDX+... + & + 0.030 * RXRAT( 137 ) ! OPEN+O3=0.03*ALDX+... + & + 0.150 * RXRAT( 143 ) ! O3+ISOP=0.15*ALDX+0.6*FORM+... + & + 0.800 * RXRAT( 144 ) ! NO3+ISOP=0.8*ALDX+0.8*NTR+... + & + 0.120 * RXRAT( 145 ) ! OH+ISPD=0.12*ALDX+... + & + 0.357 * RXRAT( 147 ) ! NO3+ISPD=0.357*ALDX+... + & + 0.150 * RXRAT( 149 ) ! TERP+O=0.15*ALDX+5.12*PAR+... + & + 0.470 * RXRAT( 150 ) ! TERP+OH=0.47*ALDX+1.25*XO2+... + & + 0.210 * RXRAT( 151 ) ! TERP+O3=0.21*ALDX+0.07*HO2+... + & + 0.470 * RXRAT( 152 ) ! TERP+NO3=0.47*ALDX+... + & + 0.050 * RXRAT( 154 ) ! OH+ETOH=0.05*ALDX+0.9*ALD2+... + & + 0.800 * RXRAT( 156 ) ! NO2+ISOP=0.8*ALDX+0.8*NTR+... + & + 0.050 * RXRAT( 167 ) ! CL+PAR=0.05*ALDX+0.87*XO2+... + & + 0.670 * RXRAT( 170 ) ! CL+OLE=0.67*ALDX+0.33*ALD2+... + & + 0.550 * RXRAT( 171 ) ! CL+IOLE=0.55*ALDX+0.7*FMCL+... + LOSS( ALDX ) = RXRAT( 98 ) ! ALDX+O=CXO3+OH + & + RXRAT( 99 ) ! ALDX+OH=CXO3 + & + RXRAT( 100 ) ! ALDX+NO3=CXO3+HNO3 + & + RXRAT( 101 ) ! ALDX=MEO2+CO+HO2 + & + RXRAT( 175 ) ! ALDX+CL=HCL+CXO3 + + PROD( PAR ) = 0.200 * RXRAT( 116 ) ! O+OLE=0.2*PAR+0.3*ALDX+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*PAR+0.66*ALDX+... + & + 1.100 * RXRAT( 138 ) ! OH+XYL=1.1*PAR+0.5*XO2+... + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*PAR+0.5*FORM+... + & + 0.350 * RXRAT( 143 ) ! O3+ISOP=0.35*PAR+0.6*FORM+... + & + 2.400 * RXRAT( 144 ) ! NO3+ISOP=2.4*PAR+0.8*NTR+... + & + 1.565 * RXRAT( 145 ) ! OH+ISPD=1.565*PAR+... + & + 0.360 * RXRAT( 146 ) ! O3+ISPD=0.36*PAR+0.15*FORM+... + & + 1.282 * RXRAT( 147 ) ! NO3+ISPD=1.282*PAR+... + & + 0.832 * RXRAT( 148 ) ! ISPD=0.832*PAR+0.067*ALD2+... + & + 5.120 * RXRAT( 149 ) ! TERP+O=5.12*PAR+0.15*ALDX+... + & + 1.660 * RXRAT( 150 ) ! TERP+OH=1.66*PAR+1.25*XO2+... + & + 7.000 * RXRAT( 151 ) ! TERP+O3=7*PAR+0.07*HO2+... + & + 2.400 * RXRAT( 156 ) ! NO2+ISOP=2.4*PAR+0.8*NTR+... + & + 0.300 * RXRAT( 171 ) ! CL+IOLE=0.3*PAR+0.7*FMCL+... + LOSS( PAR ) = 0.660 * RXRAT( 61 ) ! NTR+OH=-0.66*PAR+HO2+... + & + 0.660 * RXRAT( 62 ) ! NTR=-0.66*PAR+HO2+... + & + 1.110 * RXRAT( 112 ) ! PAR+OH=-0.11*PAR+0.13*XO2N+... + & + 2.100 * RXRAT( 113 ) ! ROR=-2.1*PAR+0.6*ALD2+... + & + 0.700 * RXRAT( 117 ) ! OH+OLE=-0.7*PAR+0.33*ALD2+... + & + RXRAT( 118 ) ! O3+OLE=-PAR+0.74*FORM+... + & + RXRAT( 119 ) ! NO3+OLE=-PAR+FORM+0.91*XO2+... + & + 1.110 * RXRAT( 167 ) ! PAR+CL=-0.11*PAR+0.87*XO2+... + & + RXRAT( 170 ) ! CL+OLE=-PAR+0.33*ALD2+... + + PROD( CO ) = RXRAT( 73 ) ! FORM+OH=CO+HO2 + & + RXRAT( 74 ) ! FORM=CO+2*HO2 + & + RXRAT( 75 ) ! FORM=CO + & + RXRAT( 76 ) ! FORM+O=CO+HO2+OH + & + RXRAT( 77 ) ! FORM+NO3=CO+HO2+HNO3 + & + RXRAT( 86 ) ! ALD2=CO+MEO2+HO2 + & + RXRAT( 101 ) ! ALDX=CO+MEO2+HO2 + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*CO+0.3*ALDX+... + & + 0.330 * RXRAT( 118 ) ! O3+OLE=0.33*CO+0.74*FORM+... + & + RXRAT( 120 ) ! O+ETH=CO+1.7*HO2+FORM+... + & + 0.630 * RXRAT( 122 ) ! O3+ETH=0.63*CO+FORM+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*CO+0.66*ALDX+... + & + 0.250 * RXRAT( 126 ) ! IOLE+O3=0.25*CO+0.35*ALDX+... + & + RXRAT( 135 ) ! OPEN=CO+HO2+C2O3 + & + 2.000 * RXRAT( 136 ) ! OPEN+OH=2*CO+XO2+2*HO2+... + & + 0.690 * RXRAT( 137 ) ! OPEN+O3=0.69*CO+0.62*C2O3+... + & + RXRAT( 140 ) ! MGLY=CO+HO2+C2O3 + & + 0.066 * RXRAT( 143 ) ! O3+ISOP=0.066*CO+0.6*FORM+... + & + 0.334 * RXRAT( 145 ) ! OH+ISPD=0.334*CO+... + & + 0.225 * RXRAT( 146 ) ! O3+ISPD=0.225*CO+0.15*FORM+... + & + 0.643 * RXRAT( 147 ) ! NO3+ISPD=0.643*CO+... + & + 0.333 * RXRAT( 148 ) ! ISPD=0.333*CO+0.067*ALD2+... + & + 0.001 * RXRAT( 151 ) ! TERP+O3=0.001*CO+0.07*HO2+... + & + RXRAT( 164 ) ! OH+FMCL=CO+CL + & + RXRAT( 165 ) ! FMCL=CO+CL+HO2 + & + RXRAT( 173 ) ! CL+FORM=CO+HO2+HCL + LOSS( CO ) = RXRAT( 65 ) ! CO+OH=HO2 + + PROD( MEO2 ) = RXRAT( 66 ) ! OH=MEO2 + & + 0.700 * RXRAT( 70 ) ! MEPX+OH=0.7*MEO2+0.3*XO2+... + & + RXRAT( 86 ) ! ALD2=MEO2+CO+HO2 + & + RXRAT( 87 ) ! C2O3+NO=MEO2+NO2 + & + 0.900 * RXRAT( 93 ) ! C2O3+XO2=0.9*MEO2+0.1*AACD + & + 2.000 * RXRAT( 94 ) ! C2O3+C2O3=2*MEO2 + & + RXRAT( 96 ) ! PACD=MEO2+OH + & + RXRAT( 97 ) ! AACD+OH=MEO2 + & + RXRAT( 101 ) ! ALDX=MEO2+CO+HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=MEO2+XO2+HO2+ALD2 + & + RXRAT( 166 ) ! CL=MEO2+HCL + LOSS( MEO2 ) = RXRAT( 67 ) ! MEO2+NO=FORM+HO2+NO2 + & + RXRAT( 68 ) ! MEO2+HO2=MEPX + & + 2.000 * RXRAT( 69 ) ! MEO2+MEO2=1.37*FORM+... + & + 0.100 * RXRAT( 92 ) ! MEO2+C2O3=0.9*MEO2+0.9*HO2+... + & + RXRAT( 108 ) ! MEO2+CXO3=0.9*ALD2+0.9*XO2+... + + PROD( MEPX ) = RXRAT( 68 ) ! MEO2+HO2=MEPX + & + RXRAT( 81 ) ! HCO3+HO2=MEPX + LOSS( MEPX ) = RXRAT( 70 ) ! MEPX+OH=0.7*MEO2+0.3*XO2+... + & + RXRAT( 71 ) ! MEPX=FORM+HO2+OH + + PROD( MEOH ) = 0.630 * RXRAT( 69 ) ! MEO2+MEO2=0.63*MEOH+... + LOSS( MEOH ) = RXRAT( 72 ) ! MEOH+OH=FORM+HO2 + & + RXRAT( 176 ) ! MEOH+CL=HCL+HO2+FORM + + PROD( HCO3 ) = RXRAT( 78 ) ! FORM+HO2=HCO3 + LOSS( HCO3 ) = RXRAT( 79 ) ! HCO3=FORM+HO2 + & + RXRAT( 80 ) ! HCO3+NO=FACD+NO2+HO2 + & + RXRAT( 81 ) ! HCO3+HO2=MEPX + + PROD( FACD ) = RXRAT( 80 ) ! HCO3+NO=FACD+NO2+HO2 + & + 0.370 * RXRAT( 122 ) ! O3+ETH=0.37*FACD+0.63*CO+... + LOSS( FACD ) = RXRAT( 82 ) ! FACD+OH=HO2 + + PROD( PACD ) = 0.800 * RXRAT( 91 ) ! C2O3+HO2=0.8*PACD+0.2*AACD+... + & + 0.800 * RXRAT( 107 ) ! CXO3+HO2=0.8*PACD+0.2*AACD+... + LOSS( PACD ) = RXRAT( 95 ) ! PACD+OH=C2O3 + & + RXRAT( 96 ) ! PACD=MEO2+OH + + PROD( AACD ) = 0.200 * RXRAT( 91 ) ! C2O3+HO2=0.2*AACD+0.8*PACD+... + & + 0.100 * RXRAT( 92 ) ! C2O3+MEO2=0.1*AACD+0.9*HO2+... + & + 0.100 * RXRAT( 93 ) ! C2O3+XO2=0.1*AACD+0.9*MEO2 + & + 0.200 * RXRAT( 107 ) ! CXO3+HO2=0.2*AACD+0.8*PACD+... + & + 0.100 * RXRAT( 108 ) ! CXO3+MEO2=0.1*AACD+0.9*XO2+... + & + 0.100 * RXRAT( 109 ) ! CXO3+XO2=0.1*AACD+0.9*ALD2 + LOSS( AACD ) = RXRAT( 97 ) ! AACD+OH=MEO2 + + PROD( CXO3 ) = RXRAT( 98 ) ! ALDX+O=CXO3+OH + & + RXRAT( 99 ) ! ALDX+OH=CXO3 + & + RXRAT( 100 ) ! ALDX+NO3=CXO3+HNO3 + & + RXRAT( 104 ) ! PANX=CXO3+NO2 + & + RXRAT( 105 ) ! PANX=CXO3+NO2 + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*CXO3+0.5*FORM+... + & + 0.200 * RXRAT( 143 ) ! O3+ISOP=0.2*CXO3+0.6*FORM+... + & + 0.250 * RXRAT( 145 ) ! OH+ISPD=0.25*CXO3+... + & + 0.075 * RXRAT( 147 ) ! NO3+ISPD=0.075*CXO3+... + & + 0.390 * RXRAT( 151 ) ! TERP+O3=0.39*CXO3+0.07*HO2+... + & + RXRAT( 175 ) ! CL+ALDX=CXO3+HCL + LOSS( CXO3 ) = RXRAT( 102 ) ! CXO3+NO=ALD2+NO2+HO2+XO2 + & + RXRAT( 103 ) ! CXO3+NO2=PANX + & + RXRAT( 107 ) ! CXO3+HO2=0.8*PACD+0.2*AACD+... + & + RXRAT( 108 ) ! CXO3+MEO2=0.9*ALD2+0.9*XO2+... + & + RXRAT( 109 ) ! CXO3+XO2=0.9*ALD2+0.1*AACD + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*ALD2+2*XO2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=MEO2+XO2+HO2+ALD2 + + PROD( PANX ) = RXRAT( 103 ) ! CXO3+NO2=PANX + LOSS( PANX ) = RXRAT( 104 ) ! PANX=CXO3+NO2 + & + RXRAT( 105 ) ! PANX=CXO3+NO2 + & + RXRAT( 106 ) ! PANX+OH=ALD2+NO2 + + PROD( ROR ) = 0.760 * RXRAT( 112 ) ! PAR+OH=0.76*ROR+0.13*XO2N+... + & + 0.760 * RXRAT( 167 ) ! CL+PAR=0.76*ROR+0.87*XO2+... + LOSS( ROR ) = 0.980 * RXRAT( 113 ) ! ROR=0.02*ROR+0.6*ALD2+... + & + RXRAT( 114 ) ! ROR=HO2 + & + RXRAT( 115 ) ! ROR+NO2=NTR + + PROD( OLE ) = 0.300 * RXRAT( 171 ) ! CL+IOLE=0.3*OLE+0.7*FMCL+... + LOSS( OLE ) = RXRAT( 116 ) ! OLE+O=0.2*ALD2+0.3*ALDX+... + & + RXRAT( 117 ) ! OLE+OH=0.8*FORM+0.33*ALD2+... + & + RXRAT( 118 ) ! OLE+O3=0.18*ALD2+0.74*FORM+... + & + RXRAT( 119 ) ! OLE+NO3=NO2+FORM+0.91*XO2+... + & + RXRAT( 170 ) ! OLE+CL=FMCL+0.33*ALD2+... + + PROD( ETH ) = 0.0 + LOSS( ETH ) = RXRAT( 120 ) ! ETH+O=FORM+1.7*HO2+CO+... + & + RXRAT( 121 ) ! ETH+OH=XO2+1.56*FORM+... + & + RXRAT( 122 ) ! ETH+O3=FORM+0.63*CO+... + & + RXRAT( 123 ) ! ETH+NO3=NO2+XO2+2*FORM + & + RXRAT( 169 ) ! ETH+CL=FMCL+2*XO2+HO2+FORM + + PROD( IOLE ) = 0.0 + LOSS( IOLE ) = RXRAT( 124 ) ! IOLE+O=1.24*ALD2+0.66*ALDX+... + & + RXRAT( 125 ) ! IOLE+OH=1.3*ALD2+0.7*ALDX+... + & + RXRAT( 126 ) ! IOLE+O3=0.65*ALD2+... + & + RXRAT( 127 ) ! IOLE+NO3=1.18*ALD2+... + & + RXRAT( 171 ) ! IOLE+CL=0.3*HCL+0.7*FMCL+... + + PROD( TOL ) = 0.0 + LOSS( TOL ) = RXRAT( 128 ) ! TOL+OH=0.44*HO2+0.08*XO2+... + + PROD( CRES ) = 0.360 * RXRAT( 128 ) ! TOL+OH=0.36*CRES+0.08*XO2+... + & + RXRAT( 130 ) ! TO2=CRES+HO2 + & + RXRAT( 134 ) ! CRO+HO2=CRES + & + 0.200 * RXRAT( 138 ) ! OH+XYL=0.2*CRES+0.5*XO2+... + LOSS( CRES ) = RXRAT( 131 ) ! CRES+OH=0.4*CRO+0.6*XO2+... + & + RXRAT( 132 ) ! CRES+NO3=CRO+HNO3 + + PROD( TO2 ) = 0.560 * RXRAT( 128 ) ! TOL+OH=0.56*TO2+0.08*XO2+... + & + 0.300 * RXRAT( 138 ) ! OH+XYL=0.3*TO2+0.5*XO2+... + LOSS( TO2 ) = RXRAT( 129 ) ! TO2+NO=0.9*NO2+0.9*HO2+... + & + RXRAT( 130 ) ! TO2=CRES+HO2 + + PROD( TOLRO2 ) = 0.765 * RXRAT( 128 ) ! TOL+OH=0.765*TOLRO2+... + LOSS( TOLRO2 ) = RXRAT( 179 ) ! TOLRO2+NO=NO+TOLNRXN + & + RXRAT( 180 ) ! TOLRO2+HO2=HO2+TOLHRXN + + PROD( OPEN ) = 0.900 * RXRAT( 129 ) ! TO2+NO=0.9*OPEN+0.9*HO2+... + & + 0.300 * RXRAT( 131 ) ! OH+CRES=0.3*OPEN+0.6*XO2+... + LOSS( OPEN ) = RXRAT( 135 ) ! OPEN=C2O3+HO2+CO + & + RXRAT( 136 ) ! OPEN+OH=XO2+2*CO+2*HO2+... + & + RXRAT( 137 ) ! OPEN+O3=0.03*ALDX+... + + PROD( CRO ) = 0.400 * RXRAT( 131 ) ! OH+CRES=0.4*CRO+0.6*XO2+... + & + RXRAT( 132 ) ! CRES+NO3=CRO+HNO3 + LOSS( CRO ) = RXRAT( 133 ) ! CRO+NO2=NTR + & + RXRAT( 134 ) ! CRO+HO2=CRES + + PROD( MGLY ) = 0.200 * RXRAT( 137 ) ! OPEN+O3=0.2*MGLY+0.62*C2O3+... + & + 0.800 * RXRAT( 138 ) ! OH+XYL=0.8*MGLY+0.5*XO2+... + & + 0.169 * RXRAT( 145 ) ! OH+ISPD=0.169*MGLY+... + & + 0.850 * RXRAT( 146 ) ! O3+ISPD=0.85*MGLY+... + LOSS( MGLY ) = RXRAT( 139 ) ! MGLY+OH=XO2+C2O3 + & + RXRAT( 140 ) ! MGLY=C2O3+HO2+CO + + PROD( XYL ) = 0.0 + LOSS( XYL ) = RXRAT( 138 ) ! XYL+OH=0.7*HO2+0.5*XO2+... + + PROD( XYLRO2 ) = 0.804 * RXRAT( 138 ) ! OH+XYL=0.804*XYLRO2+... + LOSS( XYLRO2 ) = RXRAT( 181 ) ! XYLRO2+NO=NO+XYLNRXN + & + RXRAT( 182 ) ! XYLRO2+HO2=HO2+XYLHRXN + + PROD( ISOP ) = 0.0 + LOSS( ISOP ) = RXRAT( 141 ) ! ISOP+O=0.75*ISPD+0.5*FORM+... + & + RXRAT( 142 ) ! ISOP+OH=0.912*ISPD+... + & + RXRAT( 143 ) ! ISOP+O3=0.65*ISPD+0.6*FORM+... + & + RXRAT( 144 ) ! ISOP+NO3=0.2*ISPD+0.8*NTR+... + & + RXRAT( 156 ) ! ISOP+NO2=0.2*ISPD+0.8*NTR+... + & + RXRAT( 172 ) ! ISOP+CL=0.15*HCL+XO2+HO2+... + + PROD( ISPD ) = 0.750 * RXRAT( 141 ) ! O+ISOP=0.75*ISPD+0.5*FORM+... + & + 0.912 * RXRAT( 142 ) ! OH+ISOP=0.912*ISPD+... + & + 0.650 * RXRAT( 143 ) ! O3+ISOP=0.65*ISPD+0.6*FORM+... + & + 0.200 * RXRAT( 144 ) ! NO3+ISOP=0.2*ISPD+0.8*NTR+... + & + 0.200 * RXRAT( 156 ) ! NO2+ISOP=0.2*ISPD+0.8*NTR+... + & + RXRAT( 172 ) ! CL+ISOP=ISPD+XO2+HO2+... + LOSS( ISPD ) = RXRAT( 145 ) ! ISPD+OH=1.565*PAR+... + & + RXRAT( 146 ) ! ISPD+O3=0.114*C2O3+... + & + RXRAT( 147 ) ! ISPD+NO3=0.357*ALDX+... + & + RXRAT( 148 ) ! ISPD=0.333*CO+0.067*ALD2+... + + PROD( ISOPRXN ) = RXRAT( 142 ) ! OH+ISOP=ISOPRXN+0.629*FORM+... + LOSS( ISOPRXN ) = 0.0 + + PROD( TERP ) = 0.0 + LOSS( TERP ) = RXRAT( 149 ) ! TERP+O=0.15*ALDX+5.12*PAR+... + & + RXRAT( 150 ) ! TERP+OH=0.75*HO2+1.25*XO2+... + & + RXRAT( 151 ) ! TERP+O3=0.57*OH+0.07*HO2+... + & + RXRAT( 152 ) ! TERP+NO3=0.47*NO2+0.28*HO2+... + + PROD( TRPRXN ) = RXRAT( 149 ) ! TERP+O=TRPRXN+5.12*PAR+... + & + RXRAT( 150 ) ! TERP+OH=TRPRXN+1.25*XO2+... + & + RXRAT( 151 ) ! TERP+O3=TRPRXN+0.07*HO2+... + & + RXRAT( 152 ) ! TERP+NO3=TRPRXN+0.28*HO2+... + LOSS( TRPRXN ) = 0.0 + + PROD( SO2 ) = 0.0 + LOSS( SO2 ) = RXRAT( 153 ) ! SO2+OH=SULF+HO2+SULRXN + + PROD( SULF ) = RXRAT( 153 ) ! SO2+OH=SULF+HO2+SULRXN + LOSS( SULF ) = 0.0 + + PROD( SULRXN ) = RXRAT( 153 ) ! SO2+OH=SULRXN+HO2+SULF + LOSS( SULRXN ) = 0.0 + + PROD( ETOH ) = 0.0 + LOSS( ETOH ) = RXRAT( 154 ) ! ETOH+OH=HO2+0.9*ALD2+... + & + RXRAT( 177 ) ! ETOH+CL=HCL+HO2+ALD2 + + PROD( ETHA ) = 0.0 + LOSS( ETHA ) = RXRAT( 155 ) ! ETHA+OH=0.991*ALD2+... + & + RXRAT( 168 ) ! ETHA+CL=HCL+0.991*ALD2+... + + PROD( RN ) = 0.0 + LOSS( RN ) = RXRAT( 157 ) ! RN= (radioactive decay) + + PROD( CL2 ) = 0.300 * RXRAT( 161 ) ! CLO+CLO=0.3*CL2+1.4*CL + LOSS( CL2 ) = RXRAT( 158 ) ! CL2=2*CL + + PROD( CL ) = 2.000 * RXRAT( 158 ) ! CL2=2*CL + & + RXRAT( 159 ) ! HOCL=CL+OH + & + 1.400 * RXRAT( 161 ) ! CLO+CLO=1.4*CL+0.3*CL2 + & + RXRAT( 162 ) ! CLO+NO=CL+NO2 + & + RXRAT( 164 ) ! OH+FMCL=CL+CO + & + RXRAT( 165 ) ! FMCL=CL+CO+HO2 + & + RXRAT( 178 ) ! HCL+OH=CL + LOSS( CL ) = RXRAT( 160 ) ! CL+O3=CLO + & + RXRAT( 166 ) ! CL=HCL+MEO2 + & + RXRAT( 167 ) ! CL+PAR=HCL+0.87*XO2+... + & + RXRAT( 168 ) ! CL+ETHA=HCL+0.991*ALD2+... + & + RXRAT( 169 ) ! CL+ETH=FMCL+2*XO2+HO2+FORM + & + RXRAT( 170 ) ! CL+OLE=FMCL+0.33*ALD2+... + & + RXRAT( 171 ) ! CL+IOLE=0.3*HCL+0.7*FMCL+... + & + RXRAT( 172 ) ! CL+ISOP=0.15*HCL+XO2+HO2+... + & + RXRAT( 173 ) ! CL+FORM=HCL+HO2+CO + & + RXRAT( 174 ) ! CL+ALD2=HCL+C2O3 + & + RXRAT( 175 ) ! CL+ALDX=HCL+CXO3 + & + RXRAT( 176 ) ! CL+MEOH=HCL+HO2+FORM + & + RXRAT( 177 ) ! CL+ETOH=HCL+HO2+ALD2 + + PROD( HOCL ) = RXRAT( 163 ) ! CLO+HO2=HOCL + LOSS( HOCL ) = RXRAT( 159 ) ! HOCL=OH+CL + + PROD( CLO ) = RXRAT( 160 ) ! CL+O3=CLO + LOSS( CLO ) = 2.000 * RXRAT( 161 ) ! CLO+CLO=0.3*CL2+1.4*CL + & + RXRAT( 162 ) ! CLO+NO=CL+NO2 + & + RXRAT( 163 ) ! CLO+HO2=HOCL + + PROD( FMCL ) = RXRAT( 169 ) ! CL+ETH=FMCL+2*XO2+HO2+FORM + & + RXRAT( 170 ) ! CL+OLE=FMCL+0.33*ALD2+... + & + 0.700 * RXRAT( 171 ) ! CL+IOLE=0.7*FMCL+0.3*HCL+... + & + 0.850 * RXRAT( 172 ) ! CL+ISOP=0.85*FMCL+XO2+HO2+... + LOSS( FMCL ) = RXRAT( 164 ) ! FMCL+OH=CL+CO + & + RXRAT( 165 ) ! FMCL=CL+CO+HO2 + + PROD( HCL ) = RXRAT( 166 ) ! CL=HCL+MEO2 + & + RXRAT( 167 ) ! CL+PAR=HCL+0.87*XO2+... + & + RXRAT( 168 ) ! CL+ETHA=HCL+0.991*ALD2+... + & + 0.300 * RXRAT( 171 ) ! CL+IOLE=0.3*HCL+0.7*FMCL+... + & + 0.150 * RXRAT( 172 ) ! CL+ISOP=0.15*HCL+XO2+HO2+... + & + RXRAT( 173 ) ! CL+FORM=HCL+HO2+CO + & + RXRAT( 174 ) ! CL+ALD2=HCL+C2O3 + & + RXRAT( 175 ) ! CL+ALDX=HCL+CXO3 + & + RXRAT( 176 ) ! CL+MEOH=HCL+HO2+FORM + & + RXRAT( 177 ) ! CL+ETOH=HCL+HO2+ALD2 + LOSS( HCL ) = RXRAT( 178 ) ! HCL+OH=CL + + PROD( TOLNRXN ) = RXRAT( 179 ) ! TOLRO2+NO=TOLNRXN+NO + LOSS( TOLNRXN ) = 0.0 + + PROD( TOLHRXN ) = RXRAT( 180 ) ! TOLRO2+HO2=TOLHRXN+HO2 + LOSS( TOLHRXN ) = 0.0 + + PROD( XYLNRXN ) = RXRAT( 181 ) ! XYLRO2+NO=XYLNRXN+NO + LOSS( XYLNRXN ) = 0.0 + + PROD( XYLHRXN ) = RXRAT( 182 ) ! XYLRO2+HO2=XYLHRXN+HO2 + LOSS( XYLHRXN ) = 0.0 + + PROD( BENZENE ) = 0.0 + LOSS( BENZENE ) = RXRAT( 183 ) ! BENZENE+OH=OH+0.764*BENZRO2 + + PROD( BENZRO2 ) = 0.764 * RXRAT( 183 ) ! BENZENE+OH=0.764*BENZRO2+OH + LOSS( BENZRO2 ) = RXRAT( 184 ) ! BENZRO2+NO=NO+BNZNRXN + & + RXRAT( 185 ) ! BENZRO2+HO2=HO2+BNZHRXN + + PROD( BNZNRXN ) = RXRAT( 184 ) ! BENZRO2+NO=BNZNRXN+NO + LOSS( BNZNRXN ) = 0.0 + + PROD( BNZHRXN ) = RXRAT( 185 ) ! BENZRO2+HO2=BNZHRXN+HO2 + LOSS( BNZHRXN ) = 0.0 + + PROD( SESQ ) = 0.0 + LOSS( SESQ ) = RXRAT( 186 ) ! SESQ+O3=O3+SESQRXN + & + RXRAT( 187 ) ! SESQ+OH=OH+SESQRXN + & + RXRAT( 188 ) ! SESQ+NO3=NO3+SESQRXN + + PROD( SESQRXN ) = RXRAT( 186 ) ! SESQ+O3=SESQRXN+O3 + & + RXRAT( 187 ) ! SESQ+OH=SESQRXN+OH + & + RXRAT( 188 ) ! SESQ+NO3=SESQRXN+NO3 + LOSS( SESQRXN ) = 0.0 + + PNEG( PAR ) = 0.660 * RXRAT( 61 ) ! NTR+OH=-0.66*PAR+HO2+... + & + 0.660 * RXRAT( 62 ) ! NTR=-0.66*PAR+HO2+... + & + 2.100 * RXRAT( 113 ) ! ROR=-2.1*PAR+0.6*ALD2+... + & + 0.700 * RXRAT( 117 ) ! OH+OLE=-0.7*PAR+0.33*ALD2+... + & + RXRAT( 118 ) ! O3+OLE=-PAR+0.74*FORM+... + & + RXRAT( 119 ) ! NO3+OLE=-PAR+FORM+0.91*XO2+... + & + RXRAT( 170 ) ! CL+OLE=-PAR+0.33*ALD2+... + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrprodloss_backup.F b/models/CCTM/gas/ebi_cb05cl_RN/hrprodloss_backup.F new file mode 100755 index 0000000..1ee1231 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrprodloss_backup.F @@ -0,0 +1,629 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrprodloss.F,v 1.2 2011/10/21 16:10:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRPRODLOSS + +C*********************************************************************** +C +C FUNCTION: To compute the production and loss rates for EBI species +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C RETURN VALUES: None +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, April 1, 2008 +C +C*********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C.....INCLUDES: NONE + + +C.....ARGUMENTS: NONE + + +C.....PARAMETERS: NONE + + +C.....EXTERNAL FUNCTIONS: NONE + + +C.....SAVED VARIABLES: NONE + CHARACTER( 16 ), SAVE :: PNAME = 'HRPRODLOSS' ! Program name + + +C.....LOCAL VARIABLES: + + INTEGER ESP + +C*********************************************************************** + + + PROD( HNO3 ) = 2.000 * RXRAT( 19 ) ! N2O5=2*HNO3 + & + 2.000 * RXRAT( 20 ) ! N2O5=2*HNO3 + & + RXRAT( 28 ) ! NO2+OH=HNO3 + & + RXRAT( 48 ) ! NO3+HO2=HNO3 + & + RXRAT( 61 ) ! NTR+OH=HNO3+HO2+0.33*FORM+... + & + RXRAT( 77 ) ! FORM+NO3=HNO3+HO2+CO + & + RXRAT( 85 ) ! ALD2+NO3=HNO3+C2O3 + & + RXRAT( 100 ) ! ALDX+NO3=HNO3+CXO3 + & + RXRAT( 132 ) ! CRES+NO3=HNO3+CRO + & + 0.150 * RXRAT( 147 ) ! NO3+ISPD=0.15*HNO3+... + LOSS( HNO3 ) = RXRAT( 29 ) ! HNO3+OH=NO3 + & + RXRAT( 52 ) ! HNO3=OH+NO2 + + PROD( H2O2 ) = RXRAT( 34 ) ! HO2+HO2=H2O2 + & + RXRAT( 35 ) ! HO2+HO2=H2O2 + & + RXRAT( 42 ) ! OH+OH=H2O2 + LOSS( H2O2 ) = RXRAT( 36 ) ! H2O2=2*OH + & + RXRAT( 37 ) ! H2O2+OH=HO2 + & + RXRAT( 45 ) ! H2O2+O=OH+HO2 + + PROD( XO2 ) = RXRAT( 63 ) ! ROOH+OH=XO2+0.5*ALD2+0.5*ALDX + & + 0.300 * RXRAT( 70 ) ! MEPX+OH=0.3*XO2+0.7*MEO2+... + & + RXRAT( 102 ) ! CXO3+NO=XO2+NO2+HO2+ALD2 + & + 0.900 * RXRAT( 108 ) ! CXO3+MEO2=0.9*XO2+0.9*ALD2+... + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*XO2+2*ALD2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=XO2+MEO2+HO2+ALD2 + & + 0.870 * RXRAT( 112 ) ! PAR+OH=0.87*XO2+0.13*XO2N+... + & + 0.960 * RXRAT( 113 ) ! ROR=0.96*XO2+0.6*ALD2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*XO2+0.3*ALDX+... + & + 0.800 * RXRAT( 117 ) ! OH+OLE=0.8*XO2+0.33*ALD2+... + & + 0.220 * RXRAT( 118 ) ! O3+OLE=0.22*XO2+0.74*FORM+... + & + 0.910 * RXRAT( 119 ) ! NO3+OLE=0.91*XO2+FORM+NO2+... + & + 0.700 * RXRAT( 120 ) ! O+ETH=0.7*XO2+1.7*HO2+CO+... + & + RXRAT( 121 ) ! OH+ETH=XO2+1.56*FORM+... + & + RXRAT( 123 ) ! NO3+ETH=XO2+NO2+2*FORM + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*XO2+0.66*ALDX+... + & + RXRAT( 125 ) ! IOLE+OH=XO2+0.7*ALDX+HO2+... + & + 0.080 * RXRAT( 128 ) ! TOL+OH=0.08*XO2+0.44*HO2+... + & + 0.600 * RXRAT( 131 ) ! OH+CRES=0.6*XO2+0.4*CRO+... + & + RXRAT( 136 ) ! OPEN+OH=XO2+2*CO+2*HO2+... + & + 0.030 * RXRAT( 137 ) ! OPEN+O3=0.03*XO2+0.62*C2O3+... + & + 0.500 * RXRAT( 138 ) ! OH+XYL=0.5*XO2+0.7*HO2+... + & + RXRAT( 139 ) ! OH+MGLY=XO2+C2O3 + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*XO2+0.5*FORM+... + & + 0.991 * RXRAT( 142 ) ! OH+ISOP=0.991*XO2+... + & + 0.200 * RXRAT( 143 ) ! O3+ISOP=0.2*XO2+0.6*FORM+... + & + RXRAT( 144 ) ! NO3+ISOP=XO2+0.8*NTR+... + & + 0.713 * RXRAT( 145 ) ! OH+ISPD=0.713*XO2+... + & + 0.064 * RXRAT( 146 ) ! O3+ISPD=0.064*XO2+... + & + 0.075 * RXRAT( 147 ) ! NO3+ISPD=0.075*XO2+... + & + 0.700 * RXRAT( 148 ) ! ISPD=0.7*XO2+0.067*ALD2+... + & + 1.250 * RXRAT( 150 ) ! TERP+OH=1.25*XO2+0.75*HO2+... + & + 0.760 * RXRAT( 151 ) ! TERP+O3=0.76*XO2+0.07*HO2+... + & + 1.030 * RXRAT( 152 ) ! TERP+NO3=1.03*XO2+0.28*HO2+... + & + 0.100 * RXRAT( 154 ) ! OH+ETOH=0.1*XO2+0.9*ALD2+... + & + 0.991 * RXRAT( 155 ) ! OH+ETHA=0.991*XO2+... + & + RXRAT( 156 ) ! NO2+ISOP=XO2+0.8*NTR+... + & + 0.870 * RXRAT( 166 ) ! CL+PAR=0.87*XO2+HCL+... + & + 0.991 * RXRAT( 167 ) ! CL+ETHA=0.991*XO2+... + & + 2.000 * RXRAT( 168 ) ! CL+ETH=2*XO2+FMCL+HO2+FORM + & + 2.000 * RXRAT( 169 ) ! CL+OLE=2*XO2+0.33*ALD2+... + & + 1.700 * RXRAT( 170 ) ! CL+IOLE=1.7*XO2+0.7*FMCL+... + & + RXRAT( 171 ) ! CL+ISOP=XO2+0.15*HCL+HO2+... + LOSS( XO2 ) = RXRAT( 54 ) ! XO2+NO=NO2 + & + RXRAT( 56 ) ! XO2+HO2=ROOH + & + 2.000 * RXRAT( 58 ) ! XO2+XO2= + & + RXRAT( 60 ) ! XO2+XO2N= + & + RXRAT( 93 ) ! XO2+C2O3=0.9*MEO2+0.1*AACD + & + RXRAT( 109 ) ! XO2+CXO3=0.9*ALD2+0.1*AACD + + PROD( XO2N ) = 0.130 * RXRAT( 112 ) ! PAR+OH=0.13*XO2N+0.87*XO2+... + & + 0.040 * RXRAT( 113 ) ! ROR=0.04*XO2N+0.6*ALD2+... + & + 0.010 * RXRAT( 116 ) ! O+OLE=0.01*XO2N+0.3*ALDX+... + & + 0.090 * RXRAT( 119 ) ! NO3+OLE=0.09*XO2N+FORM+... + & + 0.088 * RXRAT( 142 ) ! OH+ISOP=0.088*XO2N+... + & + 0.250 * RXRAT( 150 ) ! TERP+OH=0.25*XO2N+1.25*XO2+... + & + 0.180 * RXRAT( 151 ) ! TERP+O3=0.18*XO2N+0.07*HO2+... + & + 0.250 * RXRAT( 152 ) ! TERP+NO3=0.25*XO2N+... + & + 0.009 * RXRAT( 155 ) ! OH+ETHA=0.009*XO2N+... + & + 0.130 * RXRAT( 166 ) ! CL+PAR=0.13*XO2N+0.87*XO2+... + & + 0.009 * RXRAT( 167 ) ! CL+ETHA=0.009*XO2N+... + LOSS( XO2N ) = RXRAT( 55 ) ! XO2N+NO=NTR + & + RXRAT( 57 ) ! XO2N+HO2=ROOH + & + 2.000 * RXRAT( 59 ) ! XO2N+XO2N= + & + RXRAT( 60 ) ! XO2N+XO2= + + PROD( NTR ) = RXRAT( 55 ) ! XO2N+NO=NTR + & + RXRAT( 115 ) ! ROR+NO2=NTR + & + 0.100 * RXRAT( 129 ) ! TO2+NO=0.1*NTR+0.9*HO2+... + & + RXRAT( 133 ) ! CRO+NO2=NTR + & + 0.800 * RXRAT( 144 ) ! NO3+ISOP=0.8*NTR+0.2*ISPD+... + & + 0.850 * RXRAT( 147 ) ! NO3+ISPD=0.85*NTR+... + & + 0.530 * RXRAT( 152 ) ! TERP+NO3=0.53*NTR+0.28*HO2+... + & + 0.800 * RXRAT( 156 ) ! NO2+ISOP=0.8*NTR+0.2*ISPD+... + LOSS( NTR ) = RXRAT( 61 ) ! NTR+OH=HNO3+HO2+0.33*FORM+... + & + RXRAT( 62 ) ! NTR=NO2+HO2+0.33*FORM+... + + PROD( ROOH ) = RXRAT( 56 ) ! XO2+HO2=ROOH + & + RXRAT( 57 ) ! XO2N+HO2=ROOH + LOSS( ROOH ) = RXRAT( 63 ) ! ROOH+OH=XO2+0.5*ALD2+0.5*ALDX + & + RXRAT( 64 ) ! ROOH=OH+HO2+0.5*ALD2+0.5*ALDX + + PROD( FORM ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*FORM+HO2+HNO3+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*FORM+HO2+NO2+... + & + RXRAT( 67 ) ! MEO2+NO=FORM+HO2+NO2 + & + 1.370 * RXRAT( 69 ) ! MEO2+MEO2=1.37*FORM+... + & + RXRAT( 71 ) ! MEPX=FORM+HO2+OH + & + RXRAT( 72 ) ! MEOH+OH=FORM+HO2 + & + RXRAT( 79 ) ! HCO3=FORM+HO2 + & + RXRAT( 92 ) ! C2O3+MEO2=FORM+0.9*HO2+... + & + 0.100 * RXRAT( 108 ) ! CXO3+MEO2=0.1*FORM+0.9*XO2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*FORM+0.3*ALDX+... + & + 0.800 * RXRAT( 117 ) ! OH+OLE=0.8*FORM+0.33*ALD2+... + & + 0.740 * RXRAT( 118 ) ! O3+OLE=0.74*FORM+0.18*ALD2+... + & + RXRAT( 119 ) ! NO3+OLE=FORM+NO2+0.91*XO2+... + & + RXRAT( 120 ) ! O+ETH=FORM+1.7*HO2+CO+... + & + 1.560 * RXRAT( 121 ) ! OH+ETH=1.56*FORM+XO2+... + & + RXRAT( 122 ) ! O3+ETH=FORM+0.63*CO+... + & + 2.000 * RXRAT( 123 ) ! NO3+ETH=2*FORM+XO2+NO2 + & + 0.250 * RXRAT( 126 ) ! IOLE+O3=0.25*FORM+... + & + RXRAT( 136 ) ! OPEN+OH=FORM+2*CO+2*HO2+... + & + 0.700 * RXRAT( 137 ) ! OPEN+O3=0.7*FORM+0.62*C2O3+... + & + 0.500 * RXRAT( 141 ) ! O+ISOP=0.5*FORM+0.75*ISPD+... + & + 0.629 * RXRAT( 142 ) ! OH+ISOP=0.629*FORM+... + & + 0.600 * RXRAT( 143 ) ! O3+ISOP=0.6*FORM+0.65*ISPD+... + & + 0.167 * RXRAT( 145 ) ! OH+ISPD=0.167*FORM+... + & + 0.150 * RXRAT( 146 ) ! O3+ISPD=0.15*FORM+... + & + 0.282 * RXRAT( 147 ) ! NO3+ISPD=0.282*FORM+... + & + 0.900 * RXRAT( 148 ) ! ISPD=0.9*FORM+0.067*ALD2+... + & + 0.280 * RXRAT( 150 ) ! TERP+OH=0.28*FORM+1.25*XO2+... + & + 0.240 * RXRAT( 151 ) ! TERP+O3=0.24*FORM+0.07*HO2+... + & + 0.100 * RXRAT( 154 ) ! OH+ETOH=0.1*FORM+0.9*ALD2+... + & + RXRAT( 168 ) ! CL+ETH=FORM+2*XO2+HO2+FMCL + & + RXRAT( 175 ) ! CL+MEOH=FORM+HO2+HCL + LOSS( FORM ) = RXRAT( 73 ) ! FORM+OH=HO2+CO + & + RXRAT( 74 ) ! FORM=2*HO2+CO + & + RXRAT( 75 ) ! FORM=CO + & + RXRAT( 76 ) ! FORM+O=OH+HO2+CO + & + RXRAT( 77 ) ! FORM+NO3=HNO3+HO2+CO + & + RXRAT( 78 ) ! FORM+HO2=HCO3 + & + RXRAT( 172 ) ! FORM+CL=HCL+HO2+CO + + PROD( ALD2 ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*ALD2+HO2+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*ALD2+HO2+... + & + 0.500 * RXRAT( 63 ) ! ROOH+OH=0.5*ALD2+XO2+0.5*ALDX + & + 0.500 * RXRAT( 64 ) ! ROOH=0.5*ALD2+HO2+OH+0.5*ALDX + & + RXRAT( 102 ) ! CXO3+NO=ALD2+NO2+HO2+XO2 + & + RXRAT( 106 ) ! PANX+OH=ALD2+NO2 + & + 0.900 * RXRAT( 108 ) ! CXO3+MEO2=0.9*ALD2+0.9*XO2+... + & + 0.900 * RXRAT( 109 ) ! CXO3+XO2=0.9*ALD2+0.1*AACD + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*ALD2+2*XO2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=ALD2+XO2+HO2+MEO2 + & + 0.060 * RXRAT( 112 ) ! PAR+OH=0.06*ALD2+0.13*XO2N+... + & + 0.600 * RXRAT( 113 ) ! ROR=0.6*ALD2+0.96*XO2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*ALD2+0.3*ALDX+... + & + 0.330 * RXRAT( 117 ) ! OH+OLE=0.33*ALD2+0.8*FORM+... + & + 0.180 * RXRAT( 118 ) ! O3+OLE=0.18*ALD2+0.74*FORM+... + & + 0.350 * RXRAT( 119 ) ! NO3+OLE=0.35*ALD2+FORM+... + & + 1.240 * RXRAT( 124 ) ! IOLE+O=1.24*ALD2+0.66*ALDX+... + & + 1.300 * RXRAT( 125 ) ! IOLE+OH=1.3*ALD2+0.7*ALDX+... + & + 0.650 * RXRAT( 126 ) ! IOLE+O3=0.65*ALD2+... + & + 1.180 * RXRAT( 127 ) ! IOLE+NO3=1.18*ALD2+... + & + 0.252 * RXRAT( 145 ) ! OH+ISPD=0.252*ALD2+... + & + 0.020 * RXRAT( 146 ) ! O3+ISPD=0.02*ALD2+... + & + 0.067 * RXRAT( 148 ) ! ISPD=0.067*ALD2+0.333*CO+... + & + 0.900 * RXRAT( 154 ) ! OH+ETOH=0.9*ALD2+HO2+... + & + 0.991 * RXRAT( 155 ) ! OH+ETHA=0.991*ALD2+... + & + 0.060 * RXRAT( 166 ) ! CL+PAR=0.06*ALD2+0.87*XO2+... + & + 0.991 * RXRAT( 167 ) ! CL+ETHA=0.991*ALD2+HCL+... + & + 0.330 * RXRAT( 169 ) ! CL+OLE=0.33*ALD2+FMCL+... + & + 0.450 * RXRAT( 170 ) ! CL+IOLE=0.45*ALD2+0.7*FMCL+... + & + RXRAT( 176 ) ! CL+ETOH=ALD2+HO2+HCL + LOSS( ALD2 ) = RXRAT( 83 ) ! ALD2+O=C2O3+OH + & + RXRAT( 84 ) ! ALD2+OH=C2O3 + & + RXRAT( 85 ) ! ALD2+NO3=C2O3+HNO3 + & + RXRAT( 86 ) ! ALD2=MEO2+CO+HO2 + & + RXRAT( 173 ) ! ALD2+CL=HCL+C2O3 + + PROD( ALDX ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*ALDX+HO2+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*ALDX+HO2+... + & + 0.500 * RXRAT( 63 ) ! ROOH+OH=0.5*ALDX+0.5*ALD2+XO2 + & + 0.500 * RXRAT( 64 ) ! ROOH=0.5*ALDX+HO2+0.5*ALD2+OH + & + 0.050 * RXRAT( 112 ) ! PAR+OH=0.05*ALDX+0.13*XO2N+... + & + 0.500 * RXRAT( 113 ) ! ROR=0.5*ALDX+0.6*ALD2+... + & + 0.300 * RXRAT( 116 ) ! O+OLE=0.3*ALDX+0.2*ALD2+... + & + 0.620 * RXRAT( 117 ) ! OH+OLE=0.62*ALDX+0.33*ALD2+... + & + 0.320 * RXRAT( 118 ) ! O3+OLE=0.32*ALDX+0.74*FORM+... + & + 0.560 * RXRAT( 119 ) ! NO3+OLE=0.56*ALDX+FORM+... + & + 0.220 * RXRAT( 121 ) ! OH+ETH=0.22*ALDX+1.56*FORM+... + & + 0.660 * RXRAT( 124 ) ! IOLE+O=0.66*ALDX+1.24*ALD2+... + & + 0.700 * RXRAT( 125 ) ! IOLE+OH=0.7*ALDX+1.3*ALD2+... + & + 0.350 * RXRAT( 126 ) ! IOLE+O3=0.35*ALDX+... + & + 0.640 * RXRAT( 127 ) ! IOLE+NO3=0.64*ALDX+... + & + 0.030 * RXRAT( 137 ) ! OPEN+O3=0.03*ALDX+... + & + 0.150 * RXRAT( 143 ) ! O3+ISOP=0.15*ALDX+0.6*FORM+... + & + 0.800 * RXRAT( 144 ) ! NO3+ISOP=0.8*ALDX+0.8*NTR+... + & + 0.120 * RXRAT( 145 ) ! OH+ISPD=0.12*ALDX+... + & + 0.357 * RXRAT( 147 ) ! NO3+ISPD=0.357*ALDX+... + & + 0.150 * RXRAT( 149 ) ! TERP+O=0.15*ALDX+5.12*PAR+... + & + 0.470 * RXRAT( 150 ) ! TERP+OH=0.47*ALDX+1.25*XO2+... + & + 0.210 * RXRAT( 151 ) ! TERP+O3=0.21*ALDX+0.07*HO2+... + & + 0.470 * RXRAT( 152 ) ! TERP+NO3=0.47*ALDX+... + & + 0.050 * RXRAT( 154 ) ! OH+ETOH=0.05*ALDX+0.9*ALD2+... + & + 0.800 * RXRAT( 156 ) ! NO2+ISOP=0.8*ALDX+0.8*NTR+... + & + 0.050 * RXRAT( 166 ) ! CL+PAR=0.05*ALDX+0.87*XO2+... + & + 0.670 * RXRAT( 169 ) ! CL+OLE=0.67*ALDX+0.33*ALD2+... + & + 0.550 * RXRAT( 170 ) ! CL+IOLE=0.55*ALDX+0.7*FMCL+... + LOSS( ALDX ) = RXRAT( 98 ) ! ALDX+O=CXO3+OH + & + RXRAT( 99 ) ! ALDX+OH=CXO3 + & + RXRAT( 100 ) ! ALDX+NO3=CXO3+HNO3 + & + RXRAT( 101 ) ! ALDX=MEO2+CO+HO2 + & + RXRAT( 174 ) ! ALDX+CL=HCL+CXO3 + + PROD( PAR ) = 0.200 * RXRAT( 116 ) ! O+OLE=0.2*PAR+0.3*ALDX+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*PAR+0.66*ALDX+... + & + 1.100 * RXRAT( 138 ) ! OH+XYL=1.1*PAR+0.5*XO2+... + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*PAR+0.5*FORM+... + & + 0.350 * RXRAT( 143 ) ! O3+ISOP=0.35*PAR+0.6*FORM+... + & + 2.400 * RXRAT( 144 ) ! NO3+ISOP=2.4*PAR+0.8*NTR+... + & + 1.565 * RXRAT( 145 ) ! OH+ISPD=1.565*PAR+... + & + 0.360 * RXRAT( 146 ) ! O3+ISPD=0.36*PAR+0.15*FORM+... + & + 1.282 * RXRAT( 147 ) ! NO3+ISPD=1.282*PAR+... + & + 0.832 * RXRAT( 148 ) ! ISPD=0.832*PAR+0.067*ALD2+... + & + 5.120 * RXRAT( 149 ) ! TERP+O=5.12*PAR+0.15*ALDX+... + & + 1.660 * RXRAT( 150 ) ! TERP+OH=1.66*PAR+1.25*XO2+... + & + 7.000 * RXRAT( 151 ) ! TERP+O3=7*PAR+0.07*HO2+... + & + 2.400 * RXRAT( 156 ) ! NO2+ISOP=2.4*PAR+0.8*NTR+... + & + 0.300 * RXRAT( 170 ) ! CL+IOLE=0.3*PAR+0.7*FMCL+... + LOSS( PAR ) = 0.660 * RXRAT( 61 ) ! NTR+OH=-0.66*PAR+HO2+... + & + 0.660 * RXRAT( 62 ) ! NTR=-0.66*PAR+HO2+... + & + 1.110 * RXRAT( 112 ) ! PAR+OH=-0.11*PAR+0.13*XO2N+... + & + 2.100 * RXRAT( 113 ) ! ROR=-2.1*PAR+0.6*ALD2+... + & + 0.700 * RXRAT( 117 ) ! OH+OLE=-0.7*PAR+0.33*ALD2+... + & + RXRAT( 118 ) ! O3+OLE=-PAR+0.74*FORM+... + & + RXRAT( 119 ) ! NO3+OLE=-PAR+FORM+0.91*XO2+... + & + 1.110 * RXRAT( 166 ) ! PAR+CL=-0.11*PAR+0.87*XO2+... + & + RXRAT( 169 ) ! CL+OLE=-PAR+0.33*ALD2+... + + PROD( CO ) = RXRAT( 73 ) ! FORM+OH=CO+HO2 + & + RXRAT( 74 ) ! FORM=CO+2*HO2 + & + RXRAT( 75 ) ! FORM=CO + & + RXRAT( 76 ) ! FORM+O=CO+HO2+OH + & + RXRAT( 77 ) ! FORM+NO3=CO+HO2+HNO3 + & + RXRAT( 86 ) ! ALD2=CO+MEO2+HO2 + & + RXRAT( 101 ) ! ALDX=CO+MEO2+HO2 + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*CO+0.3*ALDX+... + & + 0.330 * RXRAT( 118 ) ! O3+OLE=0.33*CO+0.74*FORM+... + & + RXRAT( 120 ) ! O+ETH=CO+1.7*HO2+FORM+... + & + 0.630 * RXRAT( 122 ) ! O3+ETH=0.63*CO+FORM+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*CO+0.66*ALDX+... + & + 0.250 * RXRAT( 126 ) ! IOLE+O3=0.25*CO+0.35*ALDX+... + & + RXRAT( 135 ) ! OPEN=CO+HO2+C2O3 + & + 2.000 * RXRAT( 136 ) ! OPEN+OH=2*CO+XO2+2*HO2+... + & + 0.690 * RXRAT( 137 ) ! OPEN+O3=0.69*CO+0.62*C2O3+... + & + RXRAT( 140 ) ! MGLY=CO+HO2+C2O3 + & + 0.066 * RXRAT( 143 ) ! O3+ISOP=0.066*CO+0.6*FORM+... + & + 0.334 * RXRAT( 145 ) ! OH+ISPD=0.334*CO+... + & + 0.225 * RXRAT( 146 ) ! O3+ISPD=0.225*CO+0.15*FORM+... + & + 0.643 * RXRAT( 147 ) ! NO3+ISPD=0.643*CO+... + & + 0.333 * RXRAT( 148 ) ! ISPD=0.333*CO+0.067*ALD2+... + & + 0.001 * RXRAT( 151 ) ! TERP+O3=0.001*CO+0.07*HO2+... + & + RXRAT( 163 ) ! OH+FMCL=CO+CL + & + RXRAT( 164 ) ! FMCL=CO+CL+HO2 + & + RXRAT( 172 ) ! CL+FORM=CO+HO2+HCL + LOSS( CO ) = RXRAT( 65 ) ! CO+OH=HO2 + + PROD( MEO2 ) = RXRAT( 66 ) ! OH=MEO2 + & + 0.700 * RXRAT( 70 ) ! MEPX+OH=0.7*MEO2+0.3*XO2+... + & + RXRAT( 86 ) ! ALD2=MEO2+CO+HO2 + & + RXRAT( 87 ) ! C2O3+NO=MEO2+NO2 + & + 0.900 * RXRAT( 93 ) ! C2O3+XO2=0.9*MEO2+0.1*AACD + & + 2.000 * RXRAT( 94 ) ! C2O3+C2O3=2*MEO2 + & + RXRAT( 96 ) ! PACD=MEO2+OH + & + RXRAT( 97 ) ! AACD+OH=MEO2 + & + RXRAT( 101 ) ! ALDX=MEO2+CO+HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=MEO2+XO2+HO2+ALD2 + & + RXRAT( 165 ) ! CL=MEO2+HCL + LOSS( MEO2 ) = RXRAT( 67 ) ! MEO2+NO=FORM+HO2+NO2 + & + RXRAT( 68 ) ! MEO2+HO2=MEPX + & + 2.000 * RXRAT( 69 ) ! MEO2+MEO2=1.37*FORM+... + & + 0.100 * RXRAT( 92 ) ! MEO2+C2O3=0.9*MEO2+0.9*HO2+... + & + RXRAT( 108 ) ! MEO2+CXO3=0.9*ALD2+0.9*XO2+... + + PROD( MEPX ) = RXRAT( 68 ) ! MEO2+HO2=MEPX + & + RXRAT( 81 ) ! HCO3+HO2=MEPX + LOSS( MEPX ) = RXRAT( 70 ) ! MEPX+OH=0.7*MEO2+0.3*XO2+... + & + RXRAT( 71 ) ! MEPX=FORM+HO2+OH + + PROD( MEOH ) = 0.630 * RXRAT( 69 ) ! MEO2+MEO2=0.63*MEOH+... + LOSS( MEOH ) = RXRAT( 72 ) ! MEOH+OH=FORM+HO2 + & + RXRAT( 175 ) ! MEOH+CL=HCL+HO2+FORM + + PROD( HCO3 ) = RXRAT( 78 ) ! FORM+HO2=HCO3 + LOSS( HCO3 ) = RXRAT( 79 ) ! HCO3=FORM+HO2 + & + RXRAT( 80 ) ! HCO3+NO=FACD+NO2+HO2 + & + RXRAT( 81 ) ! HCO3+HO2=MEPX + + PROD( FACD ) = RXRAT( 80 ) ! HCO3+NO=FACD+NO2+HO2 + & + 0.370 * RXRAT( 122 ) ! O3+ETH=0.37*FACD+0.63*CO+... + LOSS( FACD ) = RXRAT( 82 ) ! FACD+OH=HO2 + + PROD( PACD ) = 0.800 * RXRAT( 91 ) ! C2O3+HO2=0.8*PACD+0.2*AACD+... + & + 0.800 * RXRAT( 107 ) ! CXO3+HO2=0.8*PACD+0.2*AACD+... + LOSS( PACD ) = RXRAT( 95 ) ! PACD+OH=C2O3 + & + RXRAT( 96 ) ! PACD=MEO2+OH + + PROD( AACD ) = 0.200 * RXRAT( 91 ) ! C2O3+HO2=0.2*AACD+0.8*PACD+... + & + 0.100 * RXRAT( 92 ) ! C2O3+MEO2=0.1*AACD+0.9*HO2+... + & + 0.100 * RXRAT( 93 ) ! C2O3+XO2=0.1*AACD+0.9*MEO2 + & + 0.200 * RXRAT( 107 ) ! CXO3+HO2=0.2*AACD+0.8*PACD+... + & + 0.100 * RXRAT( 108 ) ! CXO3+MEO2=0.1*AACD+0.9*XO2+... + & + 0.100 * RXRAT( 109 ) ! CXO3+XO2=0.1*AACD+0.9*ALD2 + LOSS( AACD ) = RXRAT( 97 ) ! AACD+OH=MEO2 + + PROD( CXO3 ) = RXRAT( 98 ) ! ALDX+O=CXO3+OH + & + RXRAT( 99 ) ! ALDX+OH=CXO3 + & + RXRAT( 100 ) ! ALDX+NO3=CXO3+HNO3 + & + RXRAT( 104 ) ! PANX=CXO3+NO2 + & + RXRAT( 105 ) ! PANX=CXO3+NO2 + & + 0.250 * RXRAT( 141 ) ! O+ISOP=0.25*CXO3+0.5*FORM+... + & + 0.200 * RXRAT( 143 ) ! O3+ISOP=0.2*CXO3+0.6*FORM+... + & + 0.250 * RXRAT( 145 ) ! OH+ISPD=0.25*CXO3+... + & + 0.075 * RXRAT( 147 ) ! NO3+ISPD=0.075*CXO3+... + & + 0.390 * RXRAT( 151 ) ! TERP+O3=0.39*CXO3+0.07*HO2+... + & + RXRAT( 174 ) ! CL+ALDX=CXO3+HCL + LOSS( CXO3 ) = RXRAT( 102 ) ! CXO3+NO=ALD2+NO2+HO2+XO2 + & + RXRAT( 103 ) ! CXO3+NO2=PANX + & + RXRAT( 107 ) ! CXO3+HO2=0.8*PACD+0.2*AACD+... + & + RXRAT( 108 ) ! CXO3+MEO2=0.9*ALD2+0.9*XO2+... + & + RXRAT( 109 ) ! CXO3+XO2=0.9*ALD2+0.1*AACD + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*ALD2+2*XO2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=MEO2+XO2+HO2+ALD2 + + PROD( PANX ) = RXRAT( 103 ) ! CXO3+NO2=PANX + LOSS( PANX ) = RXRAT( 104 ) ! PANX=CXO3+NO2 + & + RXRAT( 105 ) ! PANX=CXO3+NO2 + & + RXRAT( 106 ) ! PANX+OH=ALD2+NO2 + + PROD( ROR ) = 0.760 * RXRAT( 112 ) ! PAR+OH=0.76*ROR+0.13*XO2N+... + & + 0.760 * RXRAT( 166 ) ! CL+PAR=0.76*ROR+0.87*XO2+... + LOSS( ROR ) = 0.980 * RXRAT( 113 ) ! ROR=0.02*ROR+0.6*ALD2+... + & + RXRAT( 114 ) ! ROR=HO2 + & + RXRAT( 115 ) ! ROR+NO2=NTR + + PROD( OLE ) = 0.300 * RXRAT( 170 ) ! CL+IOLE=0.3*OLE+0.7*FMCL+... + LOSS( OLE ) = RXRAT( 116 ) ! OLE+O=0.2*ALD2+0.3*ALDX+... + & + RXRAT( 117 ) ! OLE+OH=0.8*FORM+0.33*ALD2+... + & + RXRAT( 118 ) ! OLE+O3=0.18*ALD2+0.74*FORM+... + & + RXRAT( 119 ) ! OLE+NO3=NO2+FORM+0.91*XO2+... + & + RXRAT( 169 ) ! OLE+CL=FMCL+0.33*ALD2+... + + PROD( ETH ) = 0.0 + LOSS( ETH ) = RXRAT( 120 ) ! ETH+O=FORM+1.7*HO2+CO+... + & + RXRAT( 121 ) ! ETH+OH=XO2+1.56*FORM+... + & + RXRAT( 122 ) ! ETH+O3=FORM+0.63*CO+... + & + RXRAT( 123 ) ! ETH+NO3=NO2+XO2+2*FORM + & + RXRAT( 168 ) ! ETH+CL=FMCL+2*XO2+HO2+FORM + + PROD( IOLE ) = 0.0 + LOSS( IOLE ) = RXRAT( 124 ) ! IOLE+O=1.24*ALD2+0.66*ALDX+... + & + RXRAT( 125 ) ! IOLE+OH=1.3*ALD2+0.7*ALDX+... + & + RXRAT( 126 ) ! IOLE+O3=0.65*ALD2+... + & + RXRAT( 127 ) ! IOLE+NO3=1.18*ALD2+... + & + RXRAT( 170 ) ! IOLE+CL=0.3*HCL+0.7*FMCL+... + + PROD( TOL ) = 0.0 + LOSS( TOL ) = RXRAT( 128 ) ! TOL+OH=0.44*HO2+0.08*XO2+... + + PROD( CRES ) = 0.360 * RXRAT( 128 ) ! TOL+OH=0.36*CRES+0.08*XO2+... + & + RXRAT( 130 ) ! TO2=CRES+HO2 + & + RXRAT( 134 ) ! CRO+HO2=CRES + & + 0.200 * RXRAT( 138 ) ! OH+XYL=0.2*CRES+0.5*XO2+... + LOSS( CRES ) = RXRAT( 131 ) ! CRES+OH=0.4*CRO+0.6*XO2+... + & + RXRAT( 132 ) ! CRES+NO3=CRO+HNO3 + + PROD( TO2 ) = 0.560 * RXRAT( 128 ) ! TOL+OH=0.56*TO2+0.08*XO2+... + & + 0.300 * RXRAT( 138 ) ! OH+XYL=0.3*TO2+0.5*XO2+... + LOSS( TO2 ) = RXRAT( 129 ) ! TO2+NO=0.9*NO2+0.9*HO2+... + & + RXRAT( 130 ) ! TO2=CRES+HO2 + + PROD( TOLRO2 ) = 0.765 * RXRAT( 128 ) ! TOL+OH=0.765*TOLRO2+... + LOSS( TOLRO2 ) = RXRAT( 178 ) ! TOLRO2+NO=NO+TOLNRXN + & + RXRAT( 179 ) ! TOLRO2+HO2=HO2+TOLHRXN + + PROD( OPEN ) = 0.900 * RXRAT( 129 ) ! TO2+NO=0.9*OPEN+0.9*HO2+... + & + 0.300 * RXRAT( 131 ) ! OH+CRES=0.3*OPEN+0.6*XO2+... + LOSS( OPEN ) = RXRAT( 135 ) ! OPEN=C2O3+HO2+CO + & + RXRAT( 136 ) ! OPEN+OH=XO2+2*CO+2*HO2+... + & + RXRAT( 137 ) ! OPEN+O3=0.03*ALDX+... + + PROD( CRO ) = 0.400 * RXRAT( 131 ) ! OH+CRES=0.4*CRO+0.6*XO2+... + & + RXRAT( 132 ) ! CRES+NO3=CRO+HNO3 + LOSS( CRO ) = RXRAT( 133 ) ! CRO+NO2=NTR + & + RXRAT( 134 ) ! CRO+HO2=CRES + + PROD( MGLY ) = 0.200 * RXRAT( 137 ) ! OPEN+O3=0.2*MGLY+0.62*C2O3+... + & + 0.800 * RXRAT( 138 ) ! OH+XYL=0.8*MGLY+0.5*XO2+... + & + 0.168 * RXRAT( 145 ) ! OH+ISPD=0.168*MGLY+... + & + 0.850 * RXRAT( 146 ) ! O3+ISPD=0.85*MGLY+... + LOSS( MGLY ) = RXRAT( 139 ) ! MGLY+OH=XO2+C2O3 + & + RXRAT( 140 ) ! MGLY=C2O3+HO2+CO + + PROD( XYL ) = 0.0 + LOSS( XYL ) = RXRAT( 138 ) ! XYL+OH=0.7*HO2+0.5*XO2+... + + PROD( XYLRO2 ) = 0.804 * RXRAT( 138 ) ! OH+XYL=0.804*XYLRO2+... + LOSS( XYLRO2 ) = RXRAT( 180 ) ! XYLRO2+NO=NO+XYLNRXN + & + RXRAT( 181 ) ! XYLRO2+HO2=HO2+XYLHRXN + + PROD( ISOP ) = 0.0 + LOSS( ISOP ) = RXRAT( 141 ) ! ISOP+O=0.75*ISPD+0.5*FORM+... + & + RXRAT( 142 ) ! ISOP+OH=0.912*ISPD+... + & + RXRAT( 143 ) ! ISOP+O3=0.65*ISPD+0.6*FORM+... + & + RXRAT( 144 ) ! ISOP+NO3=0.2*ISPD+0.8*NTR+... + & + RXRAT( 156 ) ! ISOP+NO2=0.2*ISPD+0.8*NTR+... + & + RXRAT( 171 ) ! ISOP+CL=0.15*HCL+XO2+HO2+... + + PROD( ISPD ) = 0.750 * RXRAT( 141 ) ! O+ISOP=0.75*ISPD+0.5*FORM+... + & + 0.912 * RXRAT( 142 ) ! OH+ISOP=0.912*ISPD+... + & + 0.650 * RXRAT( 143 ) ! O3+ISOP=0.65*ISPD+0.6*FORM+... + & + 0.200 * RXRAT( 144 ) ! NO3+ISOP=0.2*ISPD+0.8*NTR+... + & + 0.200 * RXRAT( 156 ) ! NO2+ISOP=0.2*ISPD+0.8*NTR+... + & + RXRAT( 171 ) ! CL+ISOP=ISPD+XO2+HO2+... + LOSS( ISPD ) = RXRAT( 145 ) ! ISPD+OH=1.565*PAR+... + & + RXRAT( 146 ) ! ISPD+O3=0.114*C2O3+... + & + RXRAT( 147 ) ! ISPD+NO3=0.357*ALDX+... + & + RXRAT( 148 ) ! ISPD=0.333*CO+0.067*ALD2+... + + PROD( ISOPRXN ) = RXRAT( 142 ) ! OH+ISOP=ISOPRXN+0.629*FORM+... + LOSS( ISOPRXN ) = 0.0 + + PROD( TERP ) = 0.0 + LOSS( TERP ) = RXRAT( 149 ) ! TERP+O=0.15*ALDX+5.12*PAR+... + & + RXRAT( 150 ) ! TERP+OH=0.75*HO2+1.25*XO2+... + & + RXRAT( 151 ) ! TERP+O3=0.57*OH+0.07*HO2+... + & + RXRAT( 152 ) ! TERP+NO3=0.47*NO2+0.28*HO2+... + + PROD( TRPRXN ) = RXRAT( 149 ) ! TERP+O=TRPRXN+5.12*PAR+... + & + RXRAT( 150 ) ! TERP+OH=TRPRXN+1.25*XO2+... + & + RXRAT( 151 ) ! TERP+O3=TRPRXN+0.07*HO2+... + & + RXRAT( 152 ) ! TERP+NO3=TRPRXN+0.28*HO2+... + LOSS( TRPRXN ) = 0.0 + + PROD( SO2 ) = 0.0 + LOSS( SO2 ) = RXRAT( 153 ) ! SO2+OH=SULF+HO2+SULRXN + + PROD( SULF ) = RXRAT( 153 ) ! SO2+OH=SULF+HO2+SULRXN + LOSS( SULF ) = 0.0 + + PROD( SULRXN ) = RXRAT( 153 ) ! SO2+OH=SULRXN+HO2+SULF + LOSS( SULRXN ) = 0.0 + + PROD( ETOH ) = 0.0 + LOSS( ETOH ) = RXRAT( 154 ) ! ETOH+OH=HO2+0.9*ALD2+... + & + RXRAT( 176 ) ! ETOH+CL=HCL+HO2+ALD2 + + PROD( ETHA ) = 0.0 + LOSS( ETHA ) = RXRAT( 155 ) ! ETHA+OH=0.991*ALD2+... + & + RXRAT( 167 ) ! ETHA+CL=HCL+0.991*ALD2+... + + PROD( RN ) = 0.0 + LOSS( RN ) = RXRAT( ) ! RN= (radioactive decay) + + PROD( CL2 ) = 0.300 * RXRAT( 160 ) ! CLO+CLO=0.3*CL2+1.4*CL + LOSS( CL2 ) = RXRAT( 157 ) ! CL2=2*CL + + PROD( CL ) = 2.000 * RXRAT( 157 ) ! CL2=2*CL + & + RXRAT( 158 ) ! HOCL=CL+OH + & + 1.400 * RXRAT( 160 ) ! CLO+CLO=1.4*CL+0.3*CL2 + & + RXRAT( 161 ) ! CLO+NO=CL+NO2 + & + RXRAT( 163 ) ! OH+FMCL=CL+CO + & + RXRAT( 164 ) ! FMCL=CL+CO+HO2 + & + RXRAT( 177 ) ! HCL+OH=CL + LOSS( CL ) = RXRAT( 159 ) ! CL+O3=CLO + & + RXRAT( 165 ) ! CL=HCL+MEO2 + & + RXRAT( 166 ) ! CL+PAR=HCL+0.87*XO2+... + & + RXRAT( 167 ) ! CL+ETHA=HCL+0.991*ALD2+... + & + RXRAT( 168 ) ! CL+ETH=FMCL+2*XO2+HO2+FORM + & + RXRAT( 169 ) ! CL+OLE=FMCL+0.33*ALD2+... + & + RXRAT( 170 ) ! CL+IOLE=0.3*HCL+0.7*FMCL+... + & + RXRAT( 171 ) ! CL+ISOP=0.15*HCL+XO2+HO2+... + & + RXRAT( 172 ) ! CL+FORM=HCL+HO2+CO + & + RXRAT( 173 ) ! CL+ALD2=HCL+C2O3 + & + RXRAT( 174 ) ! CL+ALDX=HCL+CXO3 + & + RXRAT( 175 ) ! CL+MEOH=HCL+HO2+FORM + & + RXRAT( 176 ) ! CL+ETOH=HCL+HO2+ALD2 + + PROD( HOCL ) = RXRAT( 162 ) ! CLO+HO2=HOCL + LOSS( HOCL ) = RXRAT( 158 ) ! HOCL=OH+CL + + PROD( CLO ) = RXRAT( 159 ) ! CL+O3=CLO + LOSS( CLO ) = 2.000 * RXRAT( 160 ) ! CLO+CLO=0.3*CL2+1.4*CL + & + RXRAT( 161 ) ! CLO+NO=CL+NO2 + & + RXRAT( 162 ) ! CLO+HO2=HOCL + + PROD( FMCL ) = RXRAT( 168 ) ! CL+ETH=FMCL+2*XO2+HO2+FORM + & + RXRAT( 169 ) ! CL+OLE=FMCL+0.33*ALD2+... + & + 0.700 * RXRAT( 170 ) ! CL+IOLE=0.7*FMCL+0.3*HCL+... + & + 0.850 * RXRAT( 171 ) ! CL+ISOP=0.85*FMCL+XO2+HO2+... + LOSS( FMCL ) = RXRAT( 163 ) ! FMCL+OH=CL+CO + & + RXRAT( 164 ) ! FMCL=CL+CO+HO2 + + PROD( HCL ) = RXRAT( 165 ) ! CL=HCL+MEO2 + & + RXRAT( 166 ) ! CL+PAR=HCL+0.87*XO2+... + & + RXRAT( 167 ) ! CL+ETHA=HCL+0.991*ALD2+... + & + 0.300 * RXRAT( 170 ) ! CL+IOLE=0.3*HCL+0.7*FMCL+... + & + 0.150 * RXRAT( 171 ) ! CL+ISOP=0.15*HCL+XO2+HO2+... + & + RXRAT( 172 ) ! CL+FORM=HCL+HO2+CO + & + RXRAT( 173 ) ! CL+ALD2=HCL+C2O3 + & + RXRAT( 174 ) ! CL+ALDX=HCL+CXO3 + & + RXRAT( 175 ) ! CL+MEOH=HCL+HO2+FORM + & + RXRAT( 176 ) ! CL+ETOH=HCL+HO2+ALD2 + LOSS( HCL ) = RXRAT( 177 ) ! HCL+OH=CL + + PROD( TOLNRXN ) = RXRAT( 178 ) ! TOLRO2+NO=TOLNRXN+NO + LOSS( TOLNRXN ) = 0.0 + + PROD( TOLHRXN ) = RXRAT( 179 ) ! TOLRO2+HO2=TOLHRXN+HO2 + LOSS( TOLHRXN ) = 0.0 + + PROD( XYLNRXN ) = RXRAT( 180 ) ! XYLRO2+NO=XYLNRXN+NO + LOSS( XYLNRXN ) = 0.0 + + PROD( XYLHRXN ) = RXRAT( 181 ) ! XYLRO2+HO2=XYLHRXN+HO2 + LOSS( XYLHRXN ) = 0.0 + + PROD( BENZENE ) = 0.0 + LOSS( BENZENE ) = RXRAT( 182 ) ! BENZENE+OH=OH+0.764*BENZRO2 + + PROD( BENZRO2 ) = 0.764 * RXRAT( 182 ) ! BENZENE+OH=0.764*BENZRO2+OH + LOSS( BENZRO2 ) = RXRAT( 183 ) ! BENZRO2+NO=NO+BNZNRXN + & + RXRAT( 184 ) ! BENZRO2+HO2=HO2+BNZHRXN + + PROD( BNZNRXN ) = RXRAT( 183 ) ! BENZRO2+NO=BNZNRXN+NO + LOSS( BNZNRXN ) = 0.0 + + PROD( BNZHRXN ) = RXRAT( 184 ) ! BENZRO2+HO2=BNZHRXN+HO2 + LOSS( BNZHRXN ) = 0.0 + + PROD( SESQ ) = 0.0 + LOSS( SESQ ) = RXRAT( 185 ) ! SESQ+O3=O3+SESQRXN + & + RXRAT( 186 ) ! SESQ+OH=OH+SESQRXN + & + RXRAT( 187 ) ! SESQ+NO3=NO3+SESQRXN + + PROD( SESQRXN ) = RXRAT( 185 ) ! SESQ+O3=SESQRXN+O3 + & + RXRAT( 186 ) ! SESQ+OH=SESQRXN+OH + & + RXRAT( 187 ) ! SESQ+NO3=SESQRXN+NO3 + LOSS( SESQRXN ) = 0.0 + + PNEG( PAR ) = 0.660 * RXRAT( 61 ) ! NTR+OH=-0.66*PAR+HO2+... + & + 0.660 * RXRAT( 62 ) ! NTR=-0.66*PAR+HO2+... + & + 2.100 * RXRAT( 113 ) ! ROR=-2.1*PAR+0.6*ALD2+... + & + 0.700 * RXRAT( 117 ) ! OH+OLE=-0.7*PAR+0.33*ALD2+... + & + RXRAT( 118 ) ! O3+OLE=-PAR+0.74*FORM+... + & + RXRAT( 119 ) ! NO3+OLE=-PAR+FORM+0.91*XO2+... + & + RXRAT( 169 ) ! CL+OLE=-PAR+0.33*ALD2+... + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrrates.F b/models/CCTM/gas/ebi_cb05cl_RN/hrrates.F new file mode 100755 index 0000000..4e858f9 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrrates.F @@ -0,0 +1,255 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrrates.F,v 1.2 2011/10/21 16:10:51 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRRATES + +C*********************************************************************** +C +C FUNCTION: To calculate rates of reactions +C +C PRECONDITIONS: For the CB05CL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 31, 2008 +C +C*********************************************************************** + USE HRDATA + + IMPLICIT NONE + +C.....INCLUDES: NONE + + +C.....ARGUMENTS: NONE + + +C.....PARAMETERS: NONE + + +C.....EXTERNAL FUNCTIONS: NONE + + +C.....SAVED VARIABLES: NONE + CHARACTER( 16 ), SAVE :: PNAME = 'HRRATES' ! Program name + + +C.....LOCAL VARIABLES: None + +C*********************************************************************** +C..NOTE: RXRAT commented out are not referenced by any routine +! RXRAT( 1 ) = RKI( 1 ) * YC( NO2 ) +! RXRAT( 2 ) = RKI( 2 ) * YC( O ) +! RXRAT( 3 ) = RKI( 3 ) * YC( O3 ) * YC( NO ) +! RXRAT( 4 ) = RKI( 4 ) * YC( O ) * YC( NO2 ) + RXRAT( 5 ) = RKI( 5 ) * YC( O ) * YC( NO2 ) +! RXRAT( 6 ) = RKI( 6 ) * YC( O ) * YC( NO ) + RXRAT( 7 ) = RKI( 7 ) * YC( NO2 ) * YC( O3 ) + RXRAT( 8 ) = RKI( 8 ) * YC( O3 ) + RXRAT( 9 ) = RKI( 9 ) * YC( O3 ) +! RXRAT( 10 ) = RKI( 10 ) * YC( O1D ) +! RXRAT( 11 ) = RKI( 11 ) * YC( O1D ) +! RXRAT( 12 ) = RKI( 12 ) * YC( O3 ) * YC( OH ) +! RXRAT( 13 ) = RKI( 13 ) * YC( O3 ) * YC( HO2 ) + RXRAT( 14 ) = RKI( 14 ) * YC( NO3 ) + RXRAT( 15 ) = RKI( 15 ) * YC( NO3 ) + RXRAT( 16 ) = RKI( 16 ) * YC( NO3 ) * YC( NO ) + RXRAT( 17 ) = RKI( 17 ) * YC( NO3 ) * YC( NO2 ) +! RXRAT( 18 ) = RKI( 18 ) * YC( NO3 ) * YC( NO2 ) + RXRAT( 19 ) = RKI( 19 ) * YC( N2O5 ) + RXRAT( 20 ) = RKI( 20 ) * YC( N2O5 ) + RXRAT( 21 ) = RKI( 21 ) * YC( N2O5 ) +! RXRAT( 22 ) = RKI( 22 ) * YC( NO ) * YC( NO ) + RXRAT( 23 ) = RKI( 23 ) * YC( NO ) * YC( NO2 ) +! RXRAT( 24 ) = RKI( 24 ) * YC( NO ) * YC( OH ) + RXRAT( 25 ) = RKI( 25 ) * YC( HONO ) + RXRAT( 26 ) = RKI( 26 ) * YC( OH ) * YC( HONO ) + RXRAT( 27 ) = RKI( 27 ) * YC( HONO ) * YC( HONO ) + RXRAT( 28 ) = RKI( 28 ) * YC( NO2 ) * YC( OH ) + RXRAT( 29 ) = RKI( 29 ) * YC( OH ) * YC( HNO3 ) +! RXRAT( 30 ) = RKI( 30 ) * YC( HO2 ) * YC( NO ) +! RXRAT( 31 ) = RKI( 31 ) * YC( HO2 ) * YC( NO2 ) + RXRAT( 32 ) = RKI( 32 ) * YC( PNA ) + RXRAT( 33 ) = RKI( 33 ) * YC( OH ) * YC( PNA ) + RXRAT( 34 ) = RKI( 34 ) * YC( HO2 ) * YC( HO2 ) + RXRAT( 35 ) = RKI( 35 ) * YC( HO2 ) * YC( HO2 ) + RXRAT( 36 ) = RKI( 36 ) * YC( H2O2 ) + RXRAT( 37 ) = RKI( 37 ) * YC( OH ) * YC( H2O2 ) +! RXRAT( 38 ) = RKI( 38 ) * YC( O1D ) +! RXRAT( 39 ) = RKI( 39 ) * YC( OH ) +! RXRAT( 40 ) = RKI( 40 ) * YC( OH ) * YC( O ) + RXRAT( 41 ) = RKI( 41 ) * YC( OH ) * YC( OH ) + RXRAT( 42 ) = RKI( 42 ) * YC( OH ) * YC( OH ) +! RXRAT( 43 ) = RKI( 43 ) * YC( OH ) * YC( HO2 ) +! RXRAT( 44 ) = RKI( 44 ) * YC( HO2 ) * YC( O ) + RXRAT( 45 ) = RKI( 45 ) * YC( H2O2 ) * YC( O ) + RXRAT( 46 ) = RKI( 46 ) * YC( NO3 ) * YC( O ) + RXRAT( 47 ) = RKI( 47 ) * YC( NO3 ) * YC( OH ) + RXRAT( 48 ) = RKI( 48 ) * YC( NO3 ) * YC( HO2 ) + RXRAT( 49 ) = RKI( 49 ) * YC( NO3 ) * YC( O3 ) + RXRAT( 50 ) = RKI( 50 ) * YC( NO3 ) * YC( NO3 ) + RXRAT( 51 ) = RKI( 51 ) * YC( PNA ) + RXRAT( 52 ) = RKI( 52 ) * YC( HNO3 ) + RXRAT( 53 ) = RKI( 53 ) * YC( N2O5 ) + RXRAT( 54 ) = RKI( 54 ) * YC( XO2 ) * YC( NO ) + RXRAT( 55 ) = RKI( 55 ) * YC( XO2N ) * YC( NO ) + RXRAT( 56 ) = RKI( 56 ) * YC( XO2 ) * YC( HO2 ) + RXRAT( 57 ) = RKI( 57 ) * YC( XO2N ) * YC( HO2 ) + RXRAT( 58 ) = RKI( 58 ) * YC( XO2 ) * YC( XO2 ) + RXRAT( 59 ) = RKI( 59 ) * YC( XO2N ) * YC( XO2N ) + RXRAT( 60 ) = RKI( 60 ) * YC( XO2 ) * YC( XO2N ) + RXRAT( 61 ) = RKI( 61 ) * YC( NTR ) * YC( OH ) + RXRAT( 62 ) = RKI( 62 ) * YC( NTR ) + RXRAT( 63 ) = RKI( 63 ) * YC( ROOH ) * YC( OH ) + RXRAT( 64 ) = RKI( 64 ) * YC( ROOH ) + RXRAT( 65 ) = RKI( 65 ) * YC( OH ) * YC( CO ) + RXRAT( 66 ) = RKI( 66 ) * YC( OH ) + RXRAT( 67 ) = RKI( 67 ) * YC( MEO2 ) * YC( NO ) + RXRAT( 68 ) = RKI( 68 ) * YC( MEO2 ) * YC( HO2 ) + RXRAT( 69 ) = RKI( 69 ) * YC( MEO2 ) * YC( MEO2 ) + RXRAT( 70 ) = RKI( 70 ) * YC( MEPX ) * YC( OH ) + RXRAT( 71 ) = RKI( 71 ) * YC( MEPX ) + RXRAT( 72 ) = RKI( 72 ) * YC( MEOH ) * YC( OH ) + RXRAT( 73 ) = RKI( 73 ) * YC( FORM ) * YC( OH ) + RXRAT( 74 ) = RKI( 74 ) * YC( FORM ) + RXRAT( 75 ) = RKI( 75 ) * YC( FORM ) + RXRAT( 76 ) = RKI( 76 ) * YC( FORM ) * YC( O ) + RXRAT( 77 ) = RKI( 77 ) * YC( FORM ) * YC( NO3 ) + RXRAT( 78 ) = RKI( 78 ) * YC( FORM ) * YC( HO2 ) + RXRAT( 79 ) = RKI( 79 ) * YC( HCO3 ) + RXRAT( 80 ) = RKI( 80 ) * YC( HCO3 ) * YC( NO ) + RXRAT( 81 ) = RKI( 81 ) * YC( HCO3 ) * YC( HO2 ) + RXRAT( 82 ) = RKI( 82 ) * YC( FACD ) * YC( OH ) + RXRAT( 83 ) = RKI( 83 ) * YC( ALD2 ) * YC( O ) + RXRAT( 84 ) = RKI( 84 ) * YC( ALD2 ) * YC( OH ) + RXRAT( 85 ) = RKI( 85 ) * YC( ALD2 ) * YC( NO3 ) + RXRAT( 86 ) = RKI( 86 ) * YC( ALD2 ) + RXRAT( 87 ) = RKI( 87 ) * YC( C2O3 ) * YC( NO ) +! RXRAT( 88 ) = RKI( 88 ) * YC( C2O3 ) * YC( NO2 ) + RXRAT( 89 ) = RKI( 89 ) * YC( PAN ) + RXRAT( 90 ) = RKI( 90 ) * YC( PAN ) + RXRAT( 91 ) = RKI( 91 ) * YC( C2O3 ) * YC( HO2 ) + RXRAT( 92 ) = RKI( 92 ) * YC( C2O3 ) * YC( MEO2 ) + RXRAT( 93 ) = RKI( 93 ) * YC( C2O3 ) * YC( XO2 ) + RXRAT( 94 ) = RKI( 94 ) * YC( C2O3 ) * YC( C2O3 ) + RXRAT( 95 ) = RKI( 95 ) * YC( PACD ) * YC( OH ) + RXRAT( 96 ) = RKI( 96 ) * YC( PACD ) + RXRAT( 97 ) = RKI( 97 ) * YC( AACD ) * YC( OH ) + RXRAT( 98 ) = RKI( 98 ) * YC( ALDX ) * YC( O ) + RXRAT( 99 ) = RKI( 99 ) * YC( ALDX ) * YC( OH ) + RXRAT( 100 ) = RKI( 100 ) * YC( ALDX ) * YC( NO3 ) + RXRAT( 101 ) = RKI( 101 ) * YC( ALDX ) + RXRAT( 102 ) = RKI( 102 ) * YC( CXO3 ) * YC( NO ) + RXRAT( 103 ) = RKI( 103 ) * YC( CXO3 ) * YC( NO2 ) + RXRAT( 104 ) = RKI( 104 ) * YC( PANX ) + RXRAT( 105 ) = RKI( 105 ) * YC( PANX ) + RXRAT( 106 ) = RKI( 106 ) * YC( PANX ) * YC( OH ) + RXRAT( 107 ) = RKI( 107 ) * YC( CXO3 ) * YC( HO2 ) + RXRAT( 108 ) = RKI( 108 ) * YC( CXO3 ) * YC( MEO2 ) + RXRAT( 109 ) = RKI( 109 ) * YC( CXO3 ) * YC( XO2 ) + RXRAT( 110 ) = RKI( 110 ) * YC( CXO3 ) * YC( CXO3 ) + RXRAT( 111 ) = RKI( 111 ) * YC( CXO3 ) * YC( C2O3 ) + RXRAT( 112 ) = RKI( 112 ) * YC( PAR ) * YC( OH ) + RXRAT( 113 ) = RKI( 113 ) * YC( ROR ) + RXRAT( 114 ) = RKI( 114 ) * YC( ROR ) + RXRAT( 115 ) = RKI( 115 ) * YC( ROR ) * YC( NO2 ) + RXRAT( 116 ) = RKI( 116 ) * YC( O ) * YC( OLE ) + RXRAT( 117 ) = RKI( 117 ) * YC( OH ) * YC( OLE ) + RXRAT( 118 ) = RKI( 118 ) * YC( O3 ) * YC( OLE ) + RXRAT( 119 ) = RKI( 119 ) * YC( NO3 ) * YC( OLE ) + RXRAT( 120 ) = RKI( 120 ) * YC( O ) * YC( ETH ) + RXRAT( 121 ) = RKI( 121 ) * YC( OH ) * YC( ETH ) + RXRAT( 122 ) = RKI( 122 ) * YC( O3 ) * YC( ETH ) + RXRAT( 123 ) = RKI( 123 ) * YC( NO3 ) * YC( ETH ) + RXRAT( 124 ) = RKI( 124 ) * YC( IOLE ) * YC( O ) + RXRAT( 125 ) = RKI( 125 ) * YC( IOLE ) * YC( OH ) + RXRAT( 126 ) = RKI( 126 ) * YC( IOLE ) * YC( O3 ) + RXRAT( 127 ) = RKI( 127 ) * YC( IOLE ) * YC( NO3 ) + RXRAT( 128 ) = RKI( 128 ) * YC( TOL ) * YC( OH ) + RXRAT( 129 ) = RKI( 129 ) * YC( TO2 ) * YC( NO ) + RXRAT( 130 ) = RKI( 130 ) * YC( TO2 ) + RXRAT( 131 ) = RKI( 131 ) * YC( OH ) * YC( CRES ) + RXRAT( 132 ) = RKI( 132 ) * YC( CRES ) * YC( NO3 ) + RXRAT( 133 ) = RKI( 133 ) * YC( CRO ) * YC( NO2 ) + RXRAT( 134 ) = RKI( 134 ) * YC( CRO ) * YC( HO2 ) + RXRAT( 135 ) = RKI( 135 ) * YC( OPEN ) + RXRAT( 136 ) = RKI( 136 ) * YC( OPEN ) * YC( OH ) + RXRAT( 137 ) = RKI( 137 ) * YC( OPEN ) * YC( O3 ) + RXRAT( 138 ) = RKI( 138 ) * YC( OH ) * YC( XYL ) + RXRAT( 139 ) = RKI( 139 ) * YC( OH ) * YC( MGLY ) + RXRAT( 140 ) = RKI( 140 ) * YC( MGLY ) + RXRAT( 141 ) = RKI( 141 ) * YC( O ) * YC( ISOP ) + RXRAT( 142 ) = RKI( 142 ) * YC( OH ) * YC( ISOP ) + RXRAT( 143 ) = RKI( 143 ) * YC( O3 ) * YC( ISOP ) + RXRAT( 144 ) = RKI( 144 ) * YC( NO3 ) * YC( ISOP ) + RXRAT( 145 ) = RKI( 145 ) * YC( OH ) * YC( ISPD ) + RXRAT( 146 ) = RKI( 146 ) * YC( O3 ) * YC( ISPD ) + RXRAT( 147 ) = RKI( 147 ) * YC( NO3 ) * YC( ISPD ) + RXRAT( 148 ) = RKI( 148 ) * YC( ISPD ) + RXRAT( 149 ) = RKI( 149 ) * YC( TERP ) * YC( O ) + RXRAT( 150 ) = RKI( 150 ) * YC( TERP ) * YC( OH ) + RXRAT( 151 ) = RKI( 151 ) * YC( TERP ) * YC( O3 ) + RXRAT( 152 ) = RKI( 152 ) * YC( TERP ) * YC( NO3 ) + RXRAT( 153 ) = RKI( 153 ) * YC( SO2 ) * YC( OH ) + RXRAT( 154 ) = RKI( 154 ) * YC( OH ) * YC( ETOH ) + RXRAT( 155 ) = RKI( 155 ) * YC( OH ) * YC( ETHA ) + RXRAT( 156 ) = RKI( 156 ) * YC( NO2 ) * YC( ISOP ) + RXRAT( 157 ) = RKI( 157 ) * YC( CL2 ) + RXRAT( 158 ) = RKI( 158 ) * YC( HOCL ) + RXRAT( 159 ) = RKI( 159 ) * YC( CL ) * YC( O3 ) + RXRAT( 160 ) = RKI( 160 ) * YC( CLO ) * YC( CLO ) + RXRAT( 161 ) = RKI( 161 ) * YC( CLO ) * YC( NO ) + RXRAT( 162 ) = RKI( 162 ) * YC( CLO ) * YC( HO2 ) + RXRAT( 163 ) = RKI( 163 ) * YC( OH ) * YC( FMCL ) + RXRAT( 164 ) = RKI( 164 ) * YC( FMCL ) + RXRAT( 165 ) = RKI( 165 ) * YC( CL ) + RXRAT( 166 ) = RKI( 166 ) * YC( CL ) * YC( PAR ) + RXRAT( 167 ) = RKI( 167 ) * YC( CL ) * YC( ETHA ) + RXRAT( 168 ) = RKI( 168 ) * YC( CL ) * YC( ETH ) + RXRAT( 169 ) = RKI( 169 ) * YC( CL ) * YC( OLE ) + RXRAT( 170 ) = RKI( 170 ) * YC( CL ) * YC( IOLE ) + RXRAT( 171 ) = RKI( 171 ) * YC( CL ) * YC( ISOP ) + RXRAT( 172 ) = RKI( 172 ) * YC( CL ) * YC( FORM ) + RXRAT( 173 ) = RKI( 173 ) * YC( CL ) * YC( ALD2 ) + RXRAT( 174 ) = RKI( 174 ) * YC( CL ) * YC( ALDX ) + RXRAT( 175 ) = RKI( 175 ) * YC( CL ) * YC( MEOH ) + RXRAT( 176 ) = RKI( 176 ) * YC( CL ) * YC( ETOH ) + RXRAT( 177 ) = RKI( 177 ) * YC( HCL ) * YC( OH ) + RXRAT( 178 ) = RKI( 178 ) * YC( TOLRO2 ) * YC( NO ) + RXRAT( 179 ) = RKI( 179 ) * YC( TOLRO2 ) * YC( HO2 ) + RXRAT( 180 ) = RKI( 180 ) * YC( XYLRO2 ) * YC( NO ) + RXRAT( 181 ) = RKI( 181 ) * YC( XYLRO2 ) * YC( HO2 ) + RXRAT( 182 ) = RKI( 182 ) * YC( BENZENE ) * YC( OH ) + RXRAT( 183 ) = RKI( 183 ) * YC( BENZRO2 ) * YC( NO ) + RXRAT( 184 ) = RKI( 184 ) * YC( BENZRO2 ) * YC( HO2 ) + RXRAT( 185 ) = RKI( 185 ) * YC( SESQ ) * YC( O3 ) + RXRAT( 186 ) = RKI( 186 ) * YC( SESQ ) * YC( OH ) + RXRAT( 187 ) = RKI( 187 ) * YC( SESQ ) * YC( NO3 ) + + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05cl_RN/hrsolver.F b/models/CCTM/gas/ebi_cb05cl_RN/hrsolver.F new file mode 100755 index 0000000..d84af3b --- /dev/null +++ b/models/CCTM/gas/ebi_cb05cl_RN/hrsolver.F @@ -0,0 +1,348 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05cl/hrsolver.F,v 1.5 2011/10/21 16:10:51 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HRSOLVER( JDATE, JTIME, C, R, L ) + +C----------------------------------------------------------------------- +C Function: EBI solver + +C Preconditions: For the CB05CL family of mechanisms + +C Key Subroutines/Functions Called: HRRATES, HRG1, HRG2, HRG3, +C HRG4, HRPRODLOSS + +C Revision History: Created by EBI solver program, Nov. 6, 2006 +C Revised hrsolver.F by Golam Sarwar, December, 2007 +C rearranged a statement suggested by CARB +C to reduce the chance of code crash; it does +C not change results +C 21 Jun 10 J.Young: convert for Namelist redesign +C 16 Feb 11 S.Roselle: replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE CGRID_SPCS, ONLY: N_GC_SPC, GC_SPC ! CGRID mechanism species + USE UTILIO_DEFN + USE HRDATA + + IMPLICIT NONE + +C..Includes: + +C..Arguments: + INTEGER JDATE ! Current date (YYYYDDD) + INTEGER JTIME ! Current time (HHMMSS) + INTEGER C, R, L ! Cell col, row, lev + +C..Parameters: + INTEGER, PARAMETER :: MXBKUPS = 5 ! Max no. of back-ups allowed + INTEGER, PARAMETER :: STAT = 1 ! Status code + + REAL, PARAMETER :: EPSLON = 1.0E-30 ! Small number + REAL, PARAMETER :: MAXPRED = 1.0E+03 ! Upper limit on predicted conc + REAL, PARAMETER :: ZERO = 0.0 ! zero + +C..External Functions: + +C..Saved Local Variables: + CHARACTER( 16 ), SAVE :: PNAME = 'HRSOLVER' ! Program name + LOGICAL, ALLOCATABLE, SAVE :: LEBISPFL( : ) ! Flag for EBI species + INTEGER IOS + LOGICAL, SAVE :: LFIRST = .TRUE. ! Flag for first call + +C..Scratch Local Variables: + + CHARACTER( 132 ) :: MSG ! Message text + + INTEGER CELLNO ! Cell no. fo debug output + INTEGER ITER ! Loop index for Backward Euler iterations + INTEGER S ! Loop index for species + INTEGER NEBI ! Loop index for time steps + INTEGER NINR ! No. of inner time steps + INTEGER N ! Loop index + INTEGER EBI ! Loop index + INTEGER NBKUPS ! No. of times time step reduced + + LOGICAL LEBI_CONV ! Flag for EBI convergence + LOGICAL MXFL ! hit MAXPRED flag + + REAL DTC ! Time step to take + REAL FXDLOSS ! Total loss due to negative stoichiometry + REAL VARLOSS ! Loss excluding negative stoichiometry + + +#ifdef hrdebug + CHARACTER( 8 ) :: NOTE ! Convergence fail note + + INTEGER COL ! Column to generate deboug output for + INTEGER ROW ! Row to generate deboug output for + INTEGER LEV ! Level to generate deboug output for + INTEGER DBGOUT ! Output unit for debu outpt + + LOGICAL LDEBUG ! Debug output flag + LOGICAL, SAVE :: LOPEN = .FALSE. +#endif + +C----------------------------------------------------------------------- + + IF ( LFIRST ) THEN + LFIRST = .FALSE. + LOGDEV = INIT3( ) + + ALLOCATE ( LEBISPFL( N_GC_SPC ), STAT = IOS ) + IF ( IOS .NE. 0 ) THEN + MSG = 'Error allocating LEBISPFL' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + END IF + +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ +#ifdef hrdebug + COL = 0 + ROW = 0 + LEV = 0 + IF ( C .EQ. COL .AND. R .EQ. ROW .AND. L .EQ. LEV ) THEN +c IF ( JTIME .EQ. 160000 ) THEN + LDEBUG = .TRUE. + ELSE + LDEBUG = .FALSE. + END IF + + IF ( LDEBUG ) THEN + IF ( .NOT. LOPEN ) THEN + DBGOUT = JUNIT() + OPEN( UNIT = DBGOUT, FILE = 'debug.out' ) + LOPEN = .TRUE. + END IF + + WRITE( DBGOUT, '( A, 2I4, I3, 1X, I7, 1X, I6 ) ' ) + & 'Debug output for col/row/lev/date/time:', + & C, R, L, JDATE, JTIME + WRITE( DBGOUT, '( A, F7.2) ' ) + & 'EBI_TMSTEP = ', EBI_TMSTEP + WRITE( DBGOUT, '( A )' ) 'Starting concs and rate constants' + DO N = 1, N_SPEC + WRITE( DBGOUT, '( A, I3, 1X, A, 1X, 1PE13.5 )' ) + & 'SP ',N, GC_SPC( N ), YC( N ) + END DO + DO N = 1, N_RXNS + WRITE( DBGOUT, '( A, I3, 1X, 1PE13.5 )' ) + & 'RKI ', N, RKI( N ) + END DO + END IF +#endif +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ + + N_EBI_IT = 0 + + DO 3000 NEBI = 1, N_EBI_STEPS ! outer EBI time-tep loop + + DTC = EBI_TMSTEP + NBKUPS = 0 + N_INR_STEPS = 1 + + 100 CONTINUE ! Restart location + + DO 2000 NINR = 1, N_INR_STEPS ! No. of time steps for back-up + + DO S = 1, N_SPEC ! Set ICs for EBI iterations + YC0( S ) = YC( S ) + END DO + + DO 1000 ITER = 1, NEBITER ! EBI iteration loop + + N_EBI_IT = N_EBI_IT + 1 + + CALL HRRATES + +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ +#ifdef hrdebug + IF ( LDEBUG ) THEN + WRITE( DBGOUT, '( A, I5 )' ) 'ITER NO ', ITER + WRITE( DBGOUT, '( A, F12.5 )' ) + & ' DTC=', DTC + + IF ( ITER .EQ. 1 ) THEN + WRITE( DBGOUT, '( A )' ) 'Starting reaction rates' + DO N = 1, N_RXNS + WRITE( DBGOUT, '( A, I3, 1X, 1PE13.5 )' ) + & 'RXRAT ', N, RXRAT( N ) + END DO + END IF + END IF +#endif +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Call routines to compute concentrations of groups 1-4 +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + CALL HRG1( DTC ) + + CALL HRG2( DTC ) + + CALL HRG3( DTC ) + + CALL HRG4( DTC ) + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do the Euler backward method +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + CALL HRPRODLOSS + + DO EBI = 1, N_EBISP + S = EBISP( EBI ) + YCP( S ) = YC( S ) * ( ( YC0( S ) + PROD( S ) * DTC ) / + & ( YC( S ) + LOSS( S ) * DTC ) ) + END DO + +c..Special treatment of PAR because of negative product stoichiometry + IF ( PNEG( PAR ) .GT. 0.0 ) THEN + FXDLOSS = PNEG( PAR ) * DTC + IF ( FXDLOSS .GE. YC0( PAR ) + PROD( PAR ) * DTC ) THEN + YCP( PAR ) = 0.0 + ELSE + VARLOSS = MAX( LOSS( PAR ) - PNEG( PAR ) , ZERO ) + YCP( PAR ) = ( YC0( PAR ) + PROD( PAR ) * DTC - + & FXDLOSS ) / ( 1.0 + VARLOSS * DTC / YC( PAR ) ) + END IF + END IF + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Check for convergence +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + LEBI_CONV = .TRUE. + MXFL = .FALSE. + DO S = 1, N_SPEC + LEBISPFL( S ) = .FALSE. + YCP( S ) = MAX( EPSLON, YCP( S ) ) + IF ( ABS( YC( S ) - YCP( S ) ) .GT. RTOL( S ) * + & ( YC( S ) + YCP( S ) ) ) THEN + LEBI_CONV = .FALSE. + LEBISPFL( S ) = .TRUE. + END IF +c..if predictions growing too large, treat as a convergence failure + IF ( YCP( S ) .GT. MAXPRED ) then + MXFL = .TRUE. + GO TO 1010 + END IF + YC( S ) = YCP( S ) + END DO + +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ +#ifdef hrdebug + IF ( LDEBUG ) THEN + WRITE( DBGOUT, '( A, I5 )' ) 'Concs after ITER= ', ITER + DO S = 1, N_SPEC + + IF ( LEBISPFL( S ) ) THEN + NOTE = 'CONV FAIL' + ELSE + NOTE = ' ' + END IF + + WRITE( DBGOUT, '( I3, 1X, A, 1PE13.5, 1X, A )' ) + & S, GC_SPC( S ), YC( S ), NOTE + END DO + IF ( LEBI_CONV ) WRITE( DBGOUT, '( A )' ) + & '****Convergence achieved' + END IF +#endif +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ + + + IF ( LEBI_CONV ) GO TO 2000 + + 1000 CONTINUE + +c...Convergence failure section; cut the inner time step in half & +c.....start inner loop over unless max backups exceeded + +1010 CONTINUE + + NBKUPS = NBKUPS + 1 + + IF ( NBKUPS .LE. MXBKUPS ) THEN + + IF ( MXFL ) THEN + WRITE( LOGDEV, 92010 ) C, R, L, TRIM( GC_SPC( S ) ), NBKUPS + ELSE + WRITE( LOGDEV, 92000 ) C, R, L, NBKUPS + END IF + + + DO S = 1, N_SPEC + YC( S ) = YC0( s ) + END DO + + DTC = 0.5 * DTC + + N_INR_STEPS = 2 ** NBKUPS + + GO TO 100 + + ELSE + + WRITE( LOGDEV, 92040 ) C, R, L + + WRITE( LOGDEV, 92060 ) + DO S = 1, N_SPEC + IF ( LEBISPFL( S ) ) WRITE( LOGDEV, 92080 ) GC_SPC( S ) + END DO + + MSG = 'ERROR: Stopping because of EBI convergence failures' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + + END IF + +2000 CONTINUE + +3000 CONTINUE + + RETURN + +92000 FORMAT( 'WARNING: EBI Euler convergence failure' / + & ' Reducing EBI time step because of ', + & 'convergence failure for ' / + & ' Cell (', I3, ', ', I3, ', ', I3, ')' , + & ' Back-up number', I2 ) + +92010 FORMAT( 'WARNING: EBI Euler convergence failure' / + & ' Reducing EBI time step because of ', + & 'MAXPRED convergence failure for ' / + & ' Cell (', I3, ', ', I3, ', ', I3, ')' , + & ' and species ', A, + & ' Back-up number', I2 ) + +92040 FORMAT( 'ERROR: Max number of EBI time step reductions exceeded' + & / ' Convergence failure for cell (', I3, ', ', I3, + & ', ', I3, ')' ) + +92060 FORMAT( ' Convergence failure for the following species:' ) + +92080 FORMAT( 10X, A ) + + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN/update_spec_nums.sh b/models/CCTM/gas/ebi_cb05tucl_RN/update_spec_nums.sh new file mode 100755 index 0000000..60a1369 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN/update_spec_nums.sh @@ -0,0 +1,17 @@ +#!/bin/bash + +for i1 in `seq 206 -1 173` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrprodloss.F" +done + +for i1 in `seq 206 -1 173` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrrates.F" +done + +for i1 in `seq 206 -1 173` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrg4.F" +done + diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrcalcks.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrcalcks.F new file mode 100755 index 0000000..8bbe85d --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrcalcks.F @@ -0,0 +1,300 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrcalcks.F,v 1.2 2011/10/21 16:10:52 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HRCALCKS( NJPHOT, LSUNLIGHT, RJIN, TEMP, PRES, H2O, RK ) + +C----------------------------------------------------------------------- +C Function: To compute thermal and photolytic reaction rate +C coefficients for each reaction. +C +C Preconditions: Photolysis rates for individual species must have +C been calculated and stored in RKPHOT. Expects +C temperature in deg K, pressure in atm., water +C vapor in ppmV, and J-values in /min. +C +C Key Subroutines/Functions Called: None +C +C Revision History: Created by EBI solver program, Jan. 21, 2011 +C 31 Mar 09 J.Young: replace include files with mechanism namelists +C----------------------------------------------------------------------- + IMPLICIT NONE + +C..Includes: + INCLUDE SUBST_RXCMMN + +C..Arguments: + INTEGER NJPHOT ! Number of J-values set in PHOT + + LOGICAL LSUNLIGHT ! Flag for daytime + + REAL H2O ! Cell H2O mixing ratio (ppmV) + REAL TEMP ! Cell temperature (deg K) + REAL PRES ! Cell pressure (atm) + REAL( 8 ) :: RK( NRXNS ) + REAL RJIN( NJPHOT ) ! J-values for each cell + +C..Parameters: + REAL, PARAMETER :: COEF1 = 7.33981E+15 ! Molec/cc to ppm conv factor coefficient + REAL, PARAMETER :: CONSTC = 0.6 ! Constant for reaction type 7 + REAL, PARAMETER :: TI300 = 1.0 / 300.0 + +C..External Functions: None + +C..Saved Local Variables: + CHARACTER( 16 ), SAVE :: PNAME = 'HRCALCKS' + +C..Scratch Local Variables: + INTEGER NRT ! Loop index for reaction types + INTEGER IRXN ! Reaction number + INTEGER JNUM ! J-value species # from PHOT + INTEGER KNUM ! Reaction # for a relative rate coeff. + INTEGER N ! Loop index for reactions + + REAL RK0 ! K0 in falloff rate expressions + REAL RK1 ! k1 in falloff rate expressions + REAL RK2 ! K2 in falloff rate expressions + REAL RK3 ! K3 in falloff rate expressions + REAL XEND ! Exponent in falloff rate expressions + REAL( 8 ) :: CFACT ! molec/cc to ppm conversion factor + REAL( 8 ) :: TINV ! Reciprocal of temperature, /deg K + +C----------------------------------------------------------------------- + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set reciprical of temperatur and mole/cc to ppm conversion factor +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + TINV = 1.0 / TEMP + CFACT = COEF1 * PRES * TINV + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set photolytic rate coefficients using the photolysis J-values that +c are stored in RJBLK +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( .NOT. LSUNLIGHT ) THEN + +c..If dark in every cell, zero all photolysis rate coefficients + DO NRT = 1, NMPHOT + IRXN = IPH( NRT, 1 ) + RK( IRXN ) = 0.0 + END DO + + ELSE + +c..otherwise do all absolute rates first and then relative rates + DO NRT = 1, NMPHOT + IF ( IPH( NRT, 3 ) .NE. 0 ) THEN + IRXN = IPH( NRT, 1 ) + JNUM = IPH( NRT, 2 ) + RK( IRXN ) = RTDAT( 1, IRXN ) * RJIN( JNUM ) + END IF + END DO + + DO NRT = 1, NMPHOT + IF ( IPH( NRT, 3 ) .EQ. 0 ) THEN + IRXN = IPH( NRT, 1 ) + KNUM = IPH( NRT, 2 ) + RK( IRXN ) = RTDAT( 1,IRXN ) * RK( KNUM ) + END IF + END DO + + END IF + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 1: k=A +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN1 + IRXN = KRX1( NRT ) + RK( IRXN ) = RTDAT(1, IRXN ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 2: k=A*(T/300)**B +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN2 + IRXN = KRX2( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * ( TEMP * TI300 ) ** + & RTDAT( 2, IRXN ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 3: k=A*exp(C/T) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN3 + IRXN = KRX3( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * EXP( RTDAT( 3, IRXN ) * TINV ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 4: k=A*((T/300)**B)*exp(C/T) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN4 + IRXN = KRX4( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * ( TEMP * + & TI300 ) ** RTDAT( 2, IRXN ) * + & EXP( RTDAT( 3, IRXN ) * TINV ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 7: k=A*(1+0.6*P) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN7 + IRXN = KRX7( NRT ) + RK( IRXN ) = RTDAT( 1, IRXN ) * ( 1.0 + CONSTC * PRES ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do fall offs and special type %2 (ktype 8) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO 100 NRT = 1, NFALLOFF + + IRXN = IRRFALL( NRT ) + + IF ( KTYPE( IRXN ) .EQ. 8 ) THEN + RK0 = RTDAT( 1, IRXN ) * EXP( RTDAT( 2, IRXN ) * TINV ) + RK2 = RTDAT( 3, IRXN ) * EXP( RFDAT( 1, NRT ) * TINV ) + RK3 = 1.0E+06 * CFACT * RFDAT( 2, NRT ) * + & EXP( RFDAT( 3, NRT ) * TINV ) + RK( IRXN ) = RK0 + ( RK3 / ( 1.0 + RK3 / RK2 ) ) + + ELSE IF ( KTYPE( IRXN ) .EQ. 9 ) THEN + RK1 = RTDAT( 1,IRXN ) * EXP( RTDAT( 2, IRXN ) * TINV ) + RK2 = 1.0E+06 * CFACT * RTDAT( 3,IRXN ) * + & EXP( RFDAT( 1, NRT ) * TINV ) + & + RK( IRXN ) = RK1 + RK2 + + ELSE + RK0 = 1.0E+06 * CFACT * + & RTDAT( 1, IRXN ) * ( TEMP * TI300 ) ** + & RTDAT( 2, IRXN ) * EXP( RTDAT( 3, IRXN ) * TINV ) + RK1 = RFDAT( 1, NRT ) * ( TEMP * TI300 ) ** + & RFDAT( 2, NRT ) * EXP( RFDAT( 3,NRT ) * TINV ) + XEND = 1.0 / (( 1.0 + ( ( 1.0 / RFDAT( 5, NRT ) ) * + & LOG10( RK0 / RK1 ) ) **2 ) ) + RK( IRXN ) = ( RK0 / ( 1.0 + RK0 / RK1 ) ) * + & RFDAT( 4, NRT ) ** XEND + END IF + +100 CONTINUE + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do reaction type 5 and 6 (multipliers of above reactions) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + DO NRT = 1, KTN5 + IRXN = KRX5( NRT ) + KNUM = INT( RTDAT( 3, IRXN ) ) + RK( IRXN ) = RK( KNUM ) / ( RTDAT( 1,IRXN ) * + & EXP( RTDAT( 2, IRXN ) / TEMP ) ) + END DO + + DO NRT = 1, KTN6 + IRXN = KRX6( NRT ) + KNUM = INT( RTDAT( 2,IRXN ) ) + RK( IRXN ) = RK( KNUM ) * RTDAT( 1, IRXN ) + END DO + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Convert to ppm units as needed +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( KUNITS .EQ. 2 ) THEN + + DO 200 N = 1, NRXNS + IF ( KTYPE( N ) .NE. 0 ) THEN ! Do all non-photolytic reactions + IF ( IORDER( N ) .EQ. 2 ) THEN + RK( N ) = RK( N ) * 60.0 * CFACT + ELSE IF ( IORDER( N ) .EQ. 3 ) THEN + RK( N ) = RK( N ) * 60.0 * CFACT * CFACT + ELSE IF ( IORDER( N ) .EQ. 1 ) THEN + RK( N ) = RK( N ) * 60.0 + ELSE IF ( IORDER( N ) .EQ. 0 ) THEN + RK( N ) = RK( N ) * 60.0 / CFACT + END IF + END IF +200 CONTINUE + + ELSE + + DO 300 N = 1, NFALLOFF ! Do Falloff reactions only + IRXN = IRRFALL( N ) + IF ( IORDER( IRXN ) .EQ. 2 ) THEN + RK( IRXN ) = RK( IRXN ) * 60.0 * CFACT + ELSE IF ( IORDER( IRXN ) .EQ. 3 ) THEN + RK( IRXN ) = RK( IRXN ) * 60.0 * CFACT * CFACT + END IF +300 CONTINUE + + END IF + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Multiply rate constants by [M], [O2], [N2], or [H2O] where needed +c and return +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( NWM .GT. 0 ) THEN + DO NRT = 1, NWM + IRXN = NRXWM( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_AIR + END DO + END IF + + IF ( NWO2 .GT. 0 ) THEN + DO NRT = 1, NWO2 + IRXN = NRXWO2( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_O2 + END DO + END IF + + IF ( NWN2 .GT. 0 ) THEN + DO NRT = 1, NWN2 + IRXN = NRXWN2( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_N2 + END DO + END IF + + IF ( NWW .GT. 0 ) THEN + DO NRT = 1, NWW + IRXN = NRXWW( NRT ) + RK( IRXN ) = RK( IRXN ) * H2O + END DO + END IF + + IF ( NWCH4 .GT. 0 ) THEN + DO NRT = 1, NWCH4 + IRXN = NRXWCH4( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_CH4 + END DO + END IF + + IF ( NWH2 .GT. 0 ) THEN + DO NRT = 1, NWH2 + IRXN = NRXWH2( NRT ) + RK( IRXN ) = RK( IRXN ) * ATM_H2 + END DO + END IF + + RETURN + END + diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrdata_mod.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrdata_mod.F new file mode 100755 index 0000000..1a46f40 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrdata_mod.F @@ -0,0 +1,166 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrdata_mod.F,v 1.3 2012/01/19 15:40:50 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + MODULE HRDATA + +C----------------------------------------------------------------------- +C Function: Mechanism & solver data for EBI solver +C +C Preconditions: For the CB05TUCL family of mechanisms +C +C Key Subroutines/Functions Called: None +C +C Revision History: Created by EBI solver program, Jan. 21, 2011 +C----------------------------------------------------------------------- + +c..EBI solver fixed parameters + INTEGER, PARAMETER :: NEBITER = 1000 ! Max No. of iterations for EBI + + REAL, PARAMETER :: DELTAT = 2.5 ! EBI time step + +c..Mechanism specific variables + INTEGER N_SPEC ! No. of species in mechanism + INTEGER N_RXNS ! No. of reactions in mechanism + INTEGER N_EBISP ! No. of species solved by EBI + INTEGER NING1 ! No. of species in group 1 + INTEGER NING2 ! No. of species in group 2 + INTEGER N_SPCL_RKS ! No. of special rate constants + INTEGER N_ACTSP ! No. of species in mechanism (non-ss spec) + +c..Control flags + LOGICAL L_AE_VRSN ! Flag for aerosol version of mech + LOGICAL L_AQ_VRSN ! Flag for aqueous chemistry version of mech + +c..Miscellaneous variables + INTEGER LOGDEV ! Unit number of output log + INTEGER N_EBI_IT ! No. of iterations for EBI + INTEGER N_EBI_STEPS ! No. of time steps for EBI + INTEGER N_INR_STEPS ! No. of inner time steps for EBI + + REAL EBI_TMSTEP ! Time step for EBI loops (min) + +c...Allocatable arrays + INTEGER, ALLOCATABLE :: EBISP( : ) ! Index of EBI species + INTEGER, ALLOCATABLE :: SSASP( : ) ! Index of ss species + INTEGER, ALLOCATABLE :: ACTSP( : ) ! Index of active species + + REAL( 8 ), ALLOCATABLE :: RKI ( : ) ! Rate constants + REAL( 8 ), ALLOCATABLE :: RKI_SAV( : ) ! Saved values of RKI for SS species calcs + REAL, ALLOCATABLE :: RXRAT ( : ) ! Reaction rates + REAL, ALLOCATABLE :: RTOL ( : ) ! Species tolerances + REAL, ALLOCATABLE :: YC ( : ) ! Species concentrations + REAL, ALLOCATABLE :: YC0 ( : ) ! Species concentrations + REAL, ALLOCATABLE :: YCP ( : ) ! Species concentrations + REAL, ALLOCATABLE :: PROD ( : ) ! Prod of species + REAL, ALLOCATABLE :: LOSS ( : ) ! Loss of species + REAL, ALLOCATABLE :: PNEG ( : ) ! Negative production rates + +c..Species indices + INTEGER NO2 + INTEGER NO + INTEGER O + INTEGER O3 + INTEGER NO3 + INTEGER O1D + INTEGER OH + INTEGER HO2 + INTEGER N2O5 + INTEGER HNO3 + INTEGER HONO + INTEGER PNA + INTEGER H2O2 + INTEGER XO2 + INTEGER XO2N + INTEGER NTR + INTEGER ROOH + INTEGER FORM + INTEGER ALD2 + INTEGER ALDX + INTEGER PAR + INTEGER CO + INTEGER MEO2 + INTEGER MEPX + INTEGER MEOH + INTEGER HCO3 + INTEGER FACD + INTEGER C2O3 + INTEGER PAN + INTEGER PACD + INTEGER AACD + INTEGER CXO3 + INTEGER PANX + INTEGER ROR + INTEGER OLE + INTEGER ETH + INTEGER IOLE + INTEGER TOL + INTEGER CRES + INTEGER TO2 + INTEGER TOLRO2 + INTEGER OPEN + INTEGER MGLY + INTEGER CRO + INTEGER CAT1 + INTEGER CRON + INTEGER CRNO + INTEGER CRN2 + INTEGER CRPX + INTEGER OPO3 + INTEGER CAO2 + INTEGER OPAN + INTEGER XYL + INTEGER XYLRO2 + INTEGER ISOP + INTEGER ISPD + INTEGER ISOPRXN + INTEGER TERP + INTEGER TRPRXN + INTEGER SO2 + INTEGER SULF + INTEGER SULRXN + INTEGER ETOH + INTEGER ETHA + INTEGER RN + INTEGER RN2 + INTEGER CL2 + INTEGER CL + INTEGER HOCL + INTEGER CLO + INTEGER FMCL + INTEGER HCL + INTEGER TOLNRXN + INTEGER TOLHRXN + INTEGER XYLNRXN + INTEGER XYLHRXN + INTEGER BENZENE + INTEGER BENZRO2 + INTEGER BNZNRXN + INTEGER BNZHRXN + INTEGER SESQ + INTEGER SESQRXN + + END MODULE HRDATA diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrdriver.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrdriver.F new file mode 100755 index 0000000..4565444 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrdriver.F @@ -0,0 +1,339 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrdriver.F,v 1.4 2011/10/21 16:10:52 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE CHEM( CGRID, JDATE, JTIME, TSTEP ) + +C----------------------------------------------------------------------- +C Function: Driver subroutine for Euler Backward Iterative solver +C +C Preconditions: For the CB05TUCL family of mechanisms +C +C Key Subroutines/Functions Called: HRINIT, PHOT, HRCALCKS, HRSOLVER +C +C Revision History: Created by EBI solver program, Jan. 21, 2011 +C Based on the algorithm in "Test of Two Numerical +C Schemes for Use in Atmospheric Transport-Chemistry +C Models", O. Hertel, R. Berkowicz, J. Christensen, +C and O. Hov, Atm Env., Vol. 27A, No. 16, 1993. +C Original MEBI code developed by Ho-Chun Huang, +C SUNY, Albany -- "On the performance of numerical +C solvers for a chemistry submodel in three-dimensional +C air quality models 1. Box model simulations", +C H. Huang and J.S. Chang, JGR, Vol 106, No. D17, 2001. +C This version replaces Huang and Chang use of numerical +C solutions with analytical solutions derived in +C Hertel et al. +C 21 Jun 10 J.Young: convert for Namelist redesign +C 29 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C 11 May 11 D.Wong: incorporated twoway model implementation +C----------------------------------------------------------------------- + + USE HGRD_DEFN ! horizontal domain specifications + USE VGRD_DEFN ! vertical layer specifications + USE CGRID_SPCS ! CGRID mechanism species + USE UTILIO_DEFN + USE HRDATA + + IMPLICIT NONE + +C..Includes: + INCLUDE SUBST_FILES_ID ! CMAQ files + INCLUDE SUBST_CONST ! CMAQ constants + INCLUDE SUBST_RXCMMN ! Mechanism reaction common block + INCLUDE SUBST_EMISPRM ! Emissions processing control parameters + INCLUDE SUBST_PACTL_ID ! Process analysis control parameters + +C..Arguments: + REAL, POINTER :: CGRID( :,:,:,: ) ! Species concentrations + INTEGER JDATE ! Current date (YYYYDDD) + INTEGER JTIME ! Current time (HHMMSS) + INTEGER TSTEP( 3 ) ! Time step vector (HHMMSS) + +C..Parameters: + REAL, PARAMETER :: PA2ATM = 1.0 / STDATMPA ! Pascal to atm conv fac + +C..External Functions: + +C..Saved Local Variables: + + CHARACTER( 16 ), SAVE :: PNAME = 'HRDRIVER' ! Program name + + INTEGER, SAVE :: ISTFL ! Unit no. of iteration stat output file + LOGICAL, SAVE :: LFIRST = .TRUE. ! Flag for first call to this subroutine + + REAL, SAVE :: MAOMV ! Mol Wt of air over Mol Wt of water + +C..Scratch Local Variables: + CHARACTER( 132 ) :: MSG ! Message text + CHARACTER( 16 ) :: VNAME ! Name of I/O API data variable + + INTEGER C, E, L, R, S ! Loop indices + + INTEGER AVGEBI ! Average no. of EBI iterations + INTEGER DELT_SEC ! EBI max time step in seconds + INTEGER ESP ! Loop index for emissions species + INTEGER ITMSTEP ! Chemistry integration interval (sec) + INTEGER LEV ! Layer index + INTEGER MIDDATE ! Date at time step midpoint + INTEGER MIDTIME ! Time at time step midpoint + INTEGER MNEBI ! Min no. of EBI iterations + INTEGER MXEBI ! Max no. of EBI iterations + INTEGER NDARK ! Number of layer 1 cells in darkness + INTEGER NPH ! Index for number of phot. rxns in PHOT + INTEGER SPC ! Species loop index + INTEGER STATUS ! Status code + INTEGER VAR ! Variable number on I/O API file + + LOGICAL LSUNLIGHT ! Flag for sunlight + + REAL ATMPRES ! Cell pressure + REAL CHEMSTEP ! Chemistry integration interval (min) + REAL H2O ! Cell H2O mixing ratio (ppmV) + REAL SUMEBI ! Sum of EBI iterations + REAL TEMP ! Cell Temperature + + REAL PRES( NCOLS, NROWS, NLAYS ) ! Cell pressure (Pa) + REAL QV( NCOLS, NROWS, NLAYS ) ! Cell water vapor (Kg/Kg air) + REAL TA( NCOLS, NROWS, NLAYS ) ! Cell temperature (K) + REAL RJIN( NPHOTAB ) ! J-values for a cell + REAL RJ( NCOLS, NROWS, NLAYS, NPHOTAB ) ! J-values for each cell + + INTEGER GXOFF, GYOFF ! global origin offset from file +C for INTERPX + INTEGER, SAVE :: STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 + +C----------------------------------------------------------------------- + + IF ( N_GC_SPC .EQ. 0 ) RETURN + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c On first call, call routines to set-up for EBI solver +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + IF ( LFIRST ) THEN + + LOGDEV = INIT3( ) + + IF ( MECHNAME .NE. 'CB05TUCL_AE5_AQ_RN2' .AND. + & MECHNAME .NE. 'CB05TUCL_AE6_AQ_RN2' ) THEN + MSG = 'This version of the EBI solver can only be used with' + & // ' the CB05TUCL_RN2 chemical mechanisms' + CALL M3EXIT( PNAME, 0, 0, MSG, XSTAT1 ) + END IF + +#ifdef emis_chem + EMISVD = .FALSE. +#else + EMISVD = .TRUE. +#endif + + IF ( INDEX( MECHNAME, 'AE' ) .NE. 0 ) THEN + L_AE_VRSN = .TRUE. + ELSE + L_AE_VRSN = .FALSE. + END IF + + IF ( INDEX( MECHNAME, 'AQ' ) .NE. 0 ) THEN + L_AQ_VRSN = .TRUE. + ELSE + L_AQ_VRSN = .FALSE. + END IF + + IF ( LIRR ) THEN + MSG = 'IRR Analysis not allowed with EBI solver' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + + CALL HRINIT + + ITMSTEP = TIME2SEC( TSTEP( 2 ) ) + CHEMSTEP = FLOAT( ITMSTEP ) / 60.0 + WRITE( LOGDEV, 92000 ) CHEMSTEP, DELTAT + + WRITE( LOGDEV, 92020 ) + DO SPC = 1, N_GC_SPC + WRITE( LOGDEV, 92040 ) GC_SPC( SPC ), RTOL( SPC ) + END DO + + MAOMV = MWAIR / MWWAT + +c..If emissions processing requested stop + IF ( .NOT. EMISVD ) THEN ! assumes emis processing in gas chem + MSG = 'ERROR: EBI solver not configured to '// + & 'process emissions in chemistry' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF ! End if doing emissions + +#ifdef hrstats + ISTFL = JUNIT() + OPEN( UNIT=ISTFL, FILE='iterstat.dat' ) + WRITE( ISTFL, 94020 ) +#endif + + CALL SUBHFILE ( MET_CRO_3D, GXOFF, GYOFF, + & STRTCOLMC3, ENDCOLMC3, STRTROWMC3, ENDROWMC3 ) + + LFIRST = .FALSE. + + END IF ! First time + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +C Set date and time to center of time step, get necessary physical +C data, and get photolysis rates +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + MIDDATE = JDATE + MIDTIME = JTIME + ITMSTEP = TIME2SEC( TSTEP( 2 ) ) + CHEMSTEP = FLOAT( ITMSTEP ) / 60.0D+00 + CALL NEXTIME( MIDDATE, MIDTIME, SEC2TIME( ITMSTEP / 2 ) ) + +C.. Compute number of time step loops and step size for EBI solver + DELT_SEC = DELTAT * 60.0 + 0.1 + IF ( DELT_SEC .GE. ITMSTEP ) THEN + N_EBI_STEPS = 1 + EBI_TMSTEP = FLOAT( ITMSTEP ) / 60.0 + ELSE + IF ( MOD( ITMSTEP, DELT_SEC ) .EQ. 0 ) THEN + N_EBI_STEPS = ITMSTEP / DELT_SEC + ELSE + N_EBI_STEPS = ITMSTEP / DELT_SEC + 1 + END IF + EBI_TMSTEP = FLOAT( ITMSTEP ) / FLOAT( N_EBI_STEPS ) / 60.0 + END IF + + N_INR_STEPS = 1 + +C.. Get ambient temperature in K + + VNAME = 'TA' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MIDDATE, MIDTIME, TA ) ) THEN + MSG = 'Could not read TA from MET_CRO_3D' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + +C.. Get specific humidity in Kg H2O / Kg air + VNAME = 'QV' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MIDDATE, MIDTIME, QV ) ) THEN + MSG = 'Could not read QV from MET_CRO_3D' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + +C.. Get pressure in Pascals + VNAME = 'PRES' + IF ( .NOT. INTERPX( MET_CRO_3D, VNAME, PNAME, + & STRTCOLMC3,ENDCOLMC3, STRTROWMC3,ENDROWMC3, 1,NLAYS, + & MIDDATE, MIDTIME, PRES ) ) THEN + MSG = 'Could not read PRES from MET_CRO_3D' + CALL M3EXIT ( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + +C.. Get photolysis rates in /min + CALL PHOT ( MIDDATE, MIDTIME, JDATE, JTIME, NDARK, RJ ) + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Top of loop over cells +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +#ifdef hrstats + MNEBI = 1000 + MXEBI = 0 + SUMEBI = 0.0 +#endif + + DO L = 1, NLAYS + DO R = 1, MY_NROWS + DO C = 1, MY_NCOLS + +c..Load ICs + DO S = 1, N_GC_SPC + YC( S ) = MAX( CGRID( C, R, L, S ), 1.0E-30 ) + END DO + +c..Set physical quantities + TEMP = TA( C, R, L ) + ATMPRES = PA2ATM * PRES( C, R, L ) + H2O = MAX ( QV( C, R, L ) * MAOMV * 1.0E+06, 0.0 ) + +c..Get rate constants + LSUNLIGHT = .FALSE. + DO NPH = 1, NPHOTAB + RJIN( NPH ) = RJ( C, R, L, NPH ) + IF ( RJ( C, R, L, NPH ) .GT. 0.0 ) LSUNLIGHT = .TRUE. + END DO + + CALL HRCALCKS( NPHOTAB, LSUNLIGHT, RJIN, TEMP, + & ATMPRES, H2O, RKI ) + +c..Call EBI solver + N_EBI_IT = 0 + + CALL HRSOLVER( JDATE, JTIME, C, R, L ) + +#ifdef hrstats + MXEBI = MAX( MXEBI, N_EBI_IT ) + MNEBI = MIN( MNEBI, N_EBI_IT ) + SUMEBI = SUMEBI + FLOAT( N_EBI_IT ) +#endif + +c..Update concentration array + DO S = 1, N_GC_SPC + CGRID( C, R, L, S ) = YC( S ) + END DO + + END DO + END DO + END DO + +#ifdef hrstats + AVGEBI = SUMEBI / FLOAT( NCOLS * NROWS * NLAYS ) + WRITE( ISTFL, 94040 ) JDATE, JTIME, MNEBI, AVGEBI, MXEBI +#endif + + RETURN + +C----------------------- FORMAT STATEMENTS ---------------------------- + +92000 FORMAT( / 10X, 'Euler Backward Iterative Parameters -' + & / 10X, 'Chemistry Integration Time Interval (min):', F12.4, + & / 10X, 'EBI maximum time step (min): ', F12.4 ) + +92020 FORMAT( //10X, 'Species convergence tolerances:' ) + +92040 FORMAT( 10X, A16, 2X, 1PE12.2 ) + +92060 FORMAT( / 10X, 'Emissions Processing in Chemistry ...' + & / 10X, 'Number of Emissions Layers: ', I3 + & / 10X, 'out of total Number of Model Layers:', I3 ) + + +94020 FORMAT( 'DATE TIME ', 'MNEBI AVEBI MXEBI' ) + +94040 FORMAT( I7, 1X, I6, 1X, 3( I5, 1X ) ) + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrg1.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg1.F new file mode 100755 index 0000000..24982ca --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg1.F @@ -0,0 +1,329 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrg1.F,v 1.3 2011/10/21 16:10:52 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG1( DTC ) + +C********************************************************************** +C +C FUNCTION: To solve for the concentration of NO2, NO, O3, and O3P +C algebraically. +C +C PRECONDITIONS: For the CB05TUCL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Sept. 12, 2011 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C..INCLUDES: None + + +C..ARGUMENTS: + REAL DTC ! Time step + + +C..PARAMETERS: None + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG1' ! Prgram Name + + +C..SCRATCH LOCAL VARIABLES: + REAL O1D_S ! sum of O1D loss frequencies + REAL O3P_S ! stoich coeff for O3P from O1D + + REAL EXN_S ! sum of NO2EX loss frequencies + REAL NO2_S ! stoich coeff for NO2 from NO2EX + + + REAL R1_2 ! production term for NO from NO2 + REAL R2_1 ! production term for NO2 from NO + REAL P1, P2, P3, P12 ! production terms for NO, NO2, O3, & O3P + REAL L1, L2, L3, L12 ! loss terms for NO, NO2, O3, O3P + REAL L1_INV, L2_INV, + & L3_INV, L12_INV ! inverse of loss terms + + REAL T1, T2, T3, T4, T5 ! intermerdiate terms + REAL F1, F2, F3 ! intermerdiate terms + REAL A, B, C ! coefficients for quadratic equation + REAL Q, XX, S1, S2 ! intermerdiate terms + + REAL RK1, RK2, RK3 ! rate constants + + REAL PO3 ! temp variable for O3 + +C********************************************************************** + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c O1D Section +c 1) sum of the rate constants for all O1D loss reactions +c 2) get fractional yield of O3P from O1D loss +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + O1D_S = RKI( 10 ) ! O1D=O + & + RKI( 11 ) ! O1D=2*OH + & + RKI( 38 ) ! O1D=OH+HO2 + + O3P_S = RKI( 10 ) ! O1D=O + + O3P_S = O3P_S / O1D_S + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c NO Section +c R1_2 = production of NO from NO2 ( rates of form k[NO2][x] ) +c except NO2+NO3=NO+NO2 (it is treated as if it were NO3=NO ) +c P1 = remaining NO production terms +c L1 = loss of NO (except rxns producing NO2 - they are in R2_1) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + R1_2 = RKI( 1 ) ! NO2=NO+O + & + RKI( 4 ) * YC( O ) ! NO2+O=NO + & + 0.200 * RKI( 172 ) * YC( ISOP ) ! NO2+ISOP=0.2*NO+... + R1_2 = R1_2 * DTC + + + P1 = RXRAT( 15 ) ! NO3=NO + & + RXRAT( 17 ) ! NO2+NO3=NO+NO2 + & + RXRAT( 25 ) ! HONO=NO+OH + & + RXRAT( 27 ) ! HONO+HONO=NO+NO2 + P1 = YC0( NO ) + P1 * DTC + + + L1 = RKI( 23 ) * YC( NO2 ) ! NO+NO2=2*HONO + & + RKI( 24 ) * YC( OH ) ! NO+OH=HONO + & + RKI( 55 ) * YC( XO2N ) ! NO+XO2N=NTR + & + 0.140 * RKI( 129 ) * YC( TO2 ) ! NO+TO2=0.86*NO2+... + & + 0.140 * RKI( 149 ) * YC( CAO2 ) ! NO+CAO2=0.86*NO2+... + L1 = 1.0 + L1 * DTC + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c NO2 Section +c R2_1 = production of NO2 from NO ( rates of form k[NO][x] ) +c a) NO+O3=NO2 not included +c b) NO+NO3=2NO2 ( 1/2 of NO2 formation rate included ) +c c) NO3+NO2=NO+NO2 is not included for NO2 +c P2 = remaining NO2 production terms +c a) NO+O3=NO2 not included +c b) NO+NO3=2NO2 (1/2 of NO2 formation rate included ) +c L2 = loss of NO2 (except rxns producing NO2 - they are in R1_2) +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + R2_1 = RKI( 6 ) * YC( O ) ! NO+O=NO2 + & + RKI( 16 ) * YC( NO3 ) ! NO+NO3=2*NO2 + & + 2.000 * RKI( 22 ) * YC( NO ) ! NO+NO=2*NO2 + & + RKI( 30 ) * YC( HO2 ) ! NO+HO2=NO2+OH + & + RKI( 54 ) * YC( XO2 ) ! NO+XO2=NO2 + & + RKI( 67 ) * YC( MEO2 ) ! NO+MEO2=NO2+HO2+FORM + & + RKI( 80 ) * YC( HCO3 ) ! NO+HCO3=NO2+FACD+HO2 + & + RKI( 87 ) * YC( C2O3 ) ! NO+C2O3=NO2+MEO2 + & + RKI( 102 ) * YC( CXO3 ) ! NO+CXO3=NO2+ALD2+... + & + 0.860 * RKI( 129 ) * YC( TO2 ) ! NO+TO2=0.86*NO2+... + & + RKI( 139 ) * YC( CRN2 ) ! NO+CRN2=NO2+CRNO + & + 0.860 * RKI( 149 ) * YC( CAO2 ) ! NO+CAO2=0.86*NO2+... + & + RKI( 151 ) * YC( OPO3 ) ! NO+OPO3=NO2+XO2+... + & + RKI( 179 ) * YC( CLO ) ! NO+CLO=NO2+CL + R2_1 = R2_1 * DTC + + + P2 = RXRAT( 14 ) ! NO3=NO2+O + & + RXRAT( 16 ) ! NO+NO3=2*NO2 + & + RXRAT( 21 ) ! N2O5=NO2+NO3 + & + RXRAT( 26 ) ! OH+HONO=NO2 + & + RXRAT( 27 ) ! HONO+HONO=NO2+NO + & + RXRAT( 32 ) ! PNA=NO2+HO2 + & + RXRAT( 33 ) ! OH+PNA=NO2 + & + RXRAT( 46 ) ! NO3+O=NO2 + & + RXRAT( 47 ) ! NO3+OH=NO2+HO2 + & + RXRAT( 49 ) ! NO3+O3=NO2 + & + 2.000 * RXRAT( 50 ) ! NO3+NO3=2*NO2 + & + 0.610 * RXRAT( 51 ) ! PNA=0.61*NO2+0.61*HO2+... + & + RXRAT( 52 ) ! HNO3=NO2+OH + & + RXRAT( 53 ) ! N2O5=NO2+NO3 + & + RXRAT( 62 ) ! NTR=NO2+HO2+0.33*FORM+... + & + RXRAT( 89 ) ! PAN=NO2+C2O3 + & + RXRAT( 90 ) ! PAN=NO2+C2O3 + & + RXRAT( 104 ) ! PANX=NO2+CXO3 + & + RXRAT( 105 ) ! PANX=NO2+CXO3 + & + RXRAT( 106 ) ! PANX+OH=NO2+ALD2 + & + RXRAT( 119 ) ! NO3+OLE=NO2+FORM+... + & + RXRAT( 123 ) ! NO3+ETH=NO2+XO2+2*FORM + & + RXRAT( 127 ) ! IOLE+NO3=NO2+... + & + RXRAT( 153 ) ! OPAN=NO2+OPO3 + & + 0.200 * RXRAT( 160 ) ! NO3+ISOP=0.2*NO2+... + & + 0.470 * RXRAT( 168 ) ! TERP+NO3=0.47*NO2+... + P2 = YC0( NO2 ) + P2 * DTC + + + L2 = RKI( 5 ) * YC( O ) ! NO2+O=NO3 + & + RKI( 7 ) * YC( O3 ) ! NO2+O3=NO3 + & + RKI( 18 ) * YC( NO3 ) ! NO2+NO3=N2O5 + & + RKI( 23 ) * YC( NO ) ! NO2+NO=2*HONO + & + RKI( 28 ) * YC( OH ) ! NO2+OH=HNO3 + & + RKI( 31 ) * YC( HO2 ) ! NO2+HO2=PNA + & + RKI( 88 ) * YC( C2O3 ) ! NO2+C2O3=PAN + & + RKI( 103 ) * YC( CXO3 ) ! NO2+CXO3=PANX + & + RKI( 115 ) * YC( ROR ) ! NO2+ROR=NTR + & + RKI( 133 ) * YC( CRO ) ! NO2+CRO=CRON + & + RKI( 137 ) * YC( CRNO ) ! NO2+CRNO=2*NTR + & + RKI( 152 ) * YC( OPO3 ) ! NO2+OPO3=OPAN + & + 0.800 * RKI( 172 ) * YC( ISOP ) ! NO2+ISOP=0.2*NO+... + L2 = 1.0 + L2 * DTC + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c O3 Section +c P3 = production of O3 except O+O2=O3 +c L3 = loss terms for O3 except NO+O3=NO2 +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + P3 = 0.200 * RXRAT( 91 ) ! C2O3+HO2=0.2*O3+... + & + 0.200 * RXRAT( 107 ) ! CXO3+HO2=0.2*O3+... + P3 = YC0( O3 ) + P3 * DTC + + + L3 = RKI( 7 ) * YC( NO2 ) ! O3+NO2=NO3 + & + RKI( 8 ) ! O3=O + & + RKI( 9 ) ! O3=O1D + & + RKI( 12 ) * YC( OH ) ! O3+OH=HO2 + & + RKI( 13 ) * YC( HO2 ) ! O3+HO2=OH + & + RKI( 49 ) * YC( NO3 ) ! O3+NO3=NO2 + & + RKI( 118 ) * YC( OLE ) ! O3+OLE=0.18*ALD2+... + & + RKI( 122 ) * YC( ETH ) ! O3+ETH=FORM+... + & + RKI( 126 ) * YC( IOLE ) ! O3+IOLE=... + & + RKI( 138 ) * YC( CRNO ) ! O3+CRNO=CRN2 + & + RKI( 145 ) * YC( OPEN ) ! O3+OPEN=... + & + RKI( 159 ) * YC( ISOP ) ! O3+ISOP=... + & + RKI( 162 ) * YC( ISPD ) ! O3+ISPD=... + & + RKI( 167 ) * YC( TERP ) ! O3+TERP=0.57*OH+... + & + RKI( 177 ) * YC( CL ) ! O3+CL=CLO + L3 = 1.0 + L3 * DTC + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c O3P Section +c P12 = production of O3P except NO2+hv=O3P (J1) +c L12 = loss terms +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + P12 = RXRAT( 8 ) ! O3=O + & + O3P_S * RXRAT( 9 ) ! O3=O1D + & + RXRAT( 14 ) ! NO3=O+NO2 + & + RXRAT( 41 ) ! OH+OH=O + & + 0.500 * RXRAT( 126 ) ! IOLE+O3=0.5*O+... + P12 = YC0( O ) + P12 * DTC + + + L12 = RKI( 2 ) ! O=O3 + & + RKI( 4 ) * YC( NO2 ) ! O+NO2=NO + & + RKI( 5 ) * YC( NO2 ) ! O+NO2=NO3 + & + RKI( 6 ) * YC( NO ) ! O+NO=NO2 + & + RKI( 40 ) * YC( OH ) ! O+OH=HO2 + & + RKI( 44 ) * YC( HO2 ) ! O+HO2=OH + & + RKI( 45 ) * YC( H2O2 ) ! O+H2O2=OH+HO2 + & + RKI( 46 ) * YC( NO3 ) ! O+NO3=NO2 + & + RKI( 76 ) * YC( FORM ) ! O+FORM=OH+HO2+CO + & + RKI( 83 ) * YC( ALD2 ) ! O+ALD2=C2O3+OH + & + RKI( 98 ) * YC( ALDX ) ! O+ALDX=CXO3+OH + & + RKI( 116 ) * YC( OLE ) ! O+OLE=0.2*ALD2+... + & + RKI( 120 ) * YC( ETH ) ! O+ETH=FORM+1.7*HO2+CO+... + & + RKI( 124 ) * YC( IOLE ) ! O+IOLE=1.24*ALD2+... + & + RKI( 157 ) * YC( ISOP ) ! O+ISOP=0.75*ISPD+... + & + RKI( 165 ) * YC( TERP ) ! O+TERP=0.15*ALDX+... + L12 = 1.0 + L12 * DTC + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Solution section +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +c..compute reciprocal of loss terms + L1_INV = 1.0 / L1 + L2_INV = 1.0 / L2 + L3_INV = 1.0 / L3 + L12_INV = 1.0 / L12 + +c..compute specific k*delta t terms + RK1 = RKI( 1 ) * DTC ! J1 (NO2+hv=NO+O3P) + RK2 = RKI( 2 ) * DTC ! J2 (O3P+O2=O3) + RK3 = RKI( 3 ) * DTC ! k1_3 (NO+O3=NO2) + +c..compute terms that are used to calulate a,b & c + T1 = RK1 * L2_INV ! J1 / ( 1.0 + Lno2 * dt ) + T2 = R1_2 * L2_INV ! r1,2 / ( 1.0 + Lno2 * dt) + T3 = R2_1 * L1_INV ! r2,1 / ( 1.0 + Lno * dt) + T4 = RK2 * L12_INV ! J2 / ( 1.0 + Lo3p * dt ) + T5 = T3 * P1 - T2 * P2 ! T3 * Pno - T2 * Pno2 + + F1 = 1.0 + T2 + T3 ! factor in calculating a & b + F2 = T1 * T4 ! factor in calculating a & b + F3 = L3 * L1 + RK3 * P1 ! (1 + Lo3 * dt) (1 + lno * dt ) + ! + k1,3 * dt * Pno + + PO3 = P3 + P12 * T4 + + A = RK3 * ( F1 - F2 ) + + B = F1 * F3 + RK3 * ( F2 * ( P2 - P1 ) + PO3 + T5 ) + + C = RK3 * P1 * ( PO3 + P2 * F2 ) + F3 * T5 + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B - 4.0 * A * C ) ) + + XX = MAX( Q / A , C / Q ) + + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Species solutions +c [NO] = ( P1 + x ) / ( 1 + L1 ) +c [NO2] = ( P2 - x ) / ( 1 + L2 ) +c [O3 ] = ( P3 + Ko3p->O3 ) / (1 + K1,3 * [NO] + L3 ) +c [O3P] = ( P12 + J1 * [NO2] ) / ( 1 + L12 ) +c [O1D2] = ( Ko3->o1d * [O3] ) / ( O1D_DNM ) +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + YCP( NO ) = MAX( 0.0, ( P1 + XX ) * L1_INV ) + + YCP( NO2 ) = MAX( 0.0, ( P2 - XX ) * L2_INV ) + + S1 = P12 + RK1 * YCP( NO2 ) + + S2 = T4 * S1 + + YCP( O3 ) = ( P3 + S2 ) / ( L3 + RK3 * YCP( NO ) ) + + YCP( O ) = S1 * L12_INV + + YCP( O1D ) = RKI( 9 ) * YCP( O3 ) / O1D_S + + RETURN + + END + + diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrg2.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg2.F new file mode 100755 index 0000000..d8a84c5 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg2.F @@ -0,0 +1,343 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrg2.F,v 1.3 2011/10/21 16:10:52 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG2( DTC ) +C********************************************************************** +C +C FUNCTION: To solve for the concentration of HO, HO2, HONO, and +C HNO4 alebraically. +C +C PRECONDITIONS: For the CB05TUCL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Sept. 12, 2011 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C..INCLUDES: None + + +C..ARGUMENTS: + REAL DTC ! Time step + +C..PARAMETERS: None + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG2' ! Program name + + +C..SCRATCH LOCAL VARIABLES: + REAL O1D_S ! sum of O1D loss frequencies + REAL OH_S ! stoich coeff for OH from O1D+H2O or H2 + REAL HO2_S ! stoich coeff for HO2 from O1D+H2 rxn + REAL EXN_S ! sum of NO2EX loss frequencies + REAL XOH_S ! stoich coeff for OH & HONO from NO2EX loss rxn + REAL R4_19 ! production of OH from HONO + REAL R19_4 ! production of HONO from OH + REAL R4_5 ! production of OH from HO2 + REAL R5_4 ! production of HO2 from OH + REAL R5_21 ! production of HO2 from HNO4 + REAL R21_5 ! production of HNO4 from HO2 + REAL P4, P5, P19, P21 ! species production form other paths + REAL L4, L5, L19, L21 ! species loss terms + + REAL A, B, C ! coeffs of quadratic eq. for HO2 + REAL Q ! intermediate term + + REAL T1, T2, T3 ! intermediate terms + + REAL L21_INV ! reciprocal of HNO4 loss term + +C********************************************************************** + + +c..stoichiometric coefficient for production of HOX from O3 via O1D + O1D_S = RKI( 10 ) ! O1D=O + & + RKI( 11 ) ! O1D=2*OH + & + RKI( 38 ) ! O1D=OH+HO2 + + OH_S = 2.000 * RKI( 11 ) ! O1D=2*OH + & + RKI( 38 ) ! O1D=OH+HO2 + + OH_S = OH_S / O1D_S + + HO2_S = RKI( 38 ) ! O1D=HO2+OH + + HO2_S = HO2_S / O1D_S + +c..Production of HO from HO2 (r4,5 terms ) + R4_5 = RKI( 13 ) * YC( O3 ) ! HO2+O3=OH + & + RKI( 30 ) * YC( NO ) ! HO2+NO=OH+NO2 + & + RKI( 44 ) * YC( O ) ! HO2+O=OH + + R4_5 = R4_5 * DTC + +c..Production of HO from HONO (r4,19 terms ) + R4_19 = RKI( 25 ) ! HONO=OH+NO + + R4_19 = R4_19 * DTC + +c..Remaining HO production + P4 = OH_S * RXRAT( 9 ) ! O1D=2*OH + & + 2.000 * RXRAT( 36 ) ! H2O2=2*OH + & + RXRAT( 45 ) ! H2O2+O=OH+HO2 + & + 0.390 * RXRAT( 51 ) ! PNA=0.39*OH+0.61*HO2+... + & + RXRAT( 52 ) ! HNO3=OH+NO2 + & + RXRAT( 64 ) ! ROOH=OH+HO2+0.5*ALD2+0.5*ALDX + & + RXRAT( 71 ) ! MEPX=OH+HO2+FORM + & + RXRAT( 76 ) ! FORM+O=OH+HO2+CO + & + RXRAT( 83 ) ! ALD2+O=OH+C2O3 + & + RXRAT( 96 ) ! PACD=OH+MEO2 + & + RXRAT( 98 ) ! ALDX+O=OH+CXO3 + & + 0.100 * RXRAT( 116 ) ! O+OLE=0.1*OH+0.3*HO2+... + & + 0.100 * RXRAT( 118 ) ! O3+OLE=0.1*OH+0.44*HO2+... + & + 0.300 * RXRAT( 120 ) ! O+ETH=0.3*OH+1.7*HO2+CO+... + & + 0.130 * RXRAT( 122 ) ! O3+ETH=0.13*OH+0.13*HO2+... + & + 0.500 * RXRAT( 126 ) ! IOLE+O3=0.5*OH+0.5*HO2+... + & + RXRAT( 141 ) ! CRPX=OH+CRNO + & + 0.080 * RXRAT( 145 ) ! OPEN+O3=0.08*OH+0.76*HO2+... + & + 0.266 * RXRAT( 159 ) ! O3+ISOP=0.266*OH+0.066*HO2+... + & + 0.268 * RXRAT( 162 ) ! O3+ISPD=0.268*OH+0.154*HO2+... + & + 0.570 * RXRAT( 167 ) ! TERP+O3=0.57*OH+0.07*HO2+... + & + RXRAT( 176 ) ! HOCL=OH+CL + + P4 = YC0( OH ) + P4 * DTC + +c..Production of HO2 from OH ( r5,4 terms ) + R5_4 = RKI( 12 ) * YC( O3 ) ! OH+O3=HO2 + & + RKI( 37 ) * YC( H2O2 ) ! OH+H2O2=HO2 + & + RKI( 39 ) ! OH=HO2 + & + RKI( 40 ) * YC( O ) ! OH+O=HO2 + & + RKI( 47 ) * YC( NO3 ) ! OH+NO3=HO2+NO2 + & + RKI( 61 ) * YC( NTR ) ! OH+NTR=HO2+HNO3+... + & + RKI( 65 ) * YC( CO ) ! OH+CO=HO2 + & + 0.300 * RKI( 70 ) * YC( MEPX ) ! OH+MEPX=0.3*HO2+... + & + RKI( 72 ) * YC( MEOH ) ! OH+MEOH=HO2+FORM + & + RKI( 73 ) * YC( FORM ) ! OH+FORM=HO2+CO + & + RKI( 82 ) * YC( FACD ) ! OH+FACD=HO2 + & + 0.110 * RKI( 112 ) * YC( PAR ) ! OH+PAR=0.11*HO2+... + & + 0.950 * RKI( 117 ) * YC( OLE ) ! OH+OLE=0.95*HO2+... + & + RKI( 121 ) * YC( ETH ) ! OH+ETH=HO2+... + & + RKI( 125 ) * YC( IOLE ) ! OH+IOLE=HO2+... + & + 0.280 * RKI( 128 ) * YC( TOL ) ! OH+TOL=0.28*HO2+... + & + RKI( 131 ) * YC( CRES ) ! OH+CRES=1.12*HO2+... + & + 0.700 * RKI( 154 ) * YC( XYL ) ! OH+XYL=0.7*HO2+... + & + 0.912 * RKI( 158 ) * YC( ISOP ) ! OH+ISOP=... + & + 0.503 * RKI( 161 ) * YC( ISPD ) ! OH+ISPD=... + & + 0.750 * RKI( 166 ) * YC( TERP ) ! OH+TERP=0.75*HO2+... + & + RKI( 169 ) * YC( SO2 ) ! OH+SO2=HO2+SULF+... + & + RKI( 170 ) * YC( ETOH ) ! OH+ETOH=HO2+... + & + RKI( 171 ) * YC( ETHA ) ! OH+ETHA=HO2+... + + R5_4 = R5_4 * DTC + +c..Production of HO2 from HNO4 (r5,21 term ) + R5_21 = RKI( 32 ) ! PNA=HO2+NO2 + & + 0.610 * RKI( 51 ) ! PNA=0.61*HO2+... + + R5_21 = R5_21 * DTC + +c..Remaining HO2 production terms + P5 = HO2_S *RXRAT( 9 ) ! O1D=HO2+OH + & + RXRAT( 45 ) ! H2O2+O=HO2+OH + & + RXRAT( 62 ) ! NTR=HO2+NO2+0.33*FORM+... + & + RXRAT( 64 ) ! ROOH=HO2+OH+0.5*ALD2+0.5*ALDX + & + RXRAT( 67 ) ! MEO2+NO=HO2+FORM+NO2 + & + 0.740 * RXRAT( 69 ) ! MEO2+MEO2=0.74*HO2+... + & + RXRAT( 71 ) ! MEPX=HO2+OH+FORM + & + 2.000 * RXRAT( 74 ) ! FORM=2*HO2+CO + & + RXRAT( 76 ) ! FORM+O=HO2+OH+CO + & + RXRAT( 77 ) ! FORM+NO3=HO2+HNO3+CO + & + RXRAT( 79 ) ! HCO3=HO2+FORM + & + RXRAT( 80 ) ! HCO3+NO=HO2+NO2+FACD + & + RXRAT( 86 ) ! ALD2=HO2+CO+MEO2 + & + 0.900 * RXRAT( 92 ) ! C2O3+MEO2=0.9*HO2+0.9*MEO2+... + & + RXRAT( 101 ) ! ALDX=HO2+CO+MEO2 + & + RXRAT( 102 ) ! CXO3+NO=HO2+NO2+ALD2+XO2 + & + RXRAT( 108 ) ! CXO3+MEO2=HO2+0.9*XO2+... + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*HO2+2*XO2+2*ALD2 + & + RXRAT( 111 ) ! CXO3+C2O3=HO2+XO2+MEO2+ALD2 + & + 0.940 * RXRAT( 113 ) ! ROR=0.94*HO2+0.6*ALD2+... + & + RXRAT( 114 ) ! ROR=HO2 + & + 0.300 * RXRAT( 116 ) ! O+OLE=0.3*HO2+0.1*OH+... + & + 0.440 * RXRAT( 118 ) ! O3+OLE=0.44*HO2+0.1*OH+... + & + 1.700 * RXRAT( 120 ) ! O+ETH=1.7*HO2+0.3*OH+CO+... + & + 0.130 * RXRAT( 122 ) ! O3+ETH=0.13*HO2+0.13*OH+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*HO2+0.66*ALDX+... + & + 0.500 * RXRAT( 126 ) ! IOLE+O3=0.5*HO2+0.5*OH+... + & + RXRAT( 127 ) ! IOLE+NO3=HO2+0.64*ALDX+... + & + 1.200 * RXRAT( 129 ) ! TO2+NO=1.2*HO2+0.86*NO2+... + & + 0.120 * RXRAT( 131 ) ! OH+CRES=1.12*HO2+0.12*XO2+... + & + 0.360 * RXRAT( 132 ) ! CRES+NO3=0.36*HO2+HNO3+... + & + RXRAT( 143 ) ! OPEN=HO2+OPO3+CO + & + 0.760 * RXRAT( 145 ) ! OPEN+O3=0.76*HO2+0.08*OH+... + & + 1.200 * RXRAT( 149 ) ! CAO2+NO=1.2*HO2+0.86*NO2+... + & + RXRAT( 151 ) ! OPO3+NO=HO2+XO2+NO2+ALDX + & + RXRAT( 156 ) ! MGLY=HO2+C2O3+CO + & + 0.250 * RXRAT( 157 ) ! O+ISOP=0.25*HO2+0.5*FORM+... + & + 0.066 * RXRAT( 159 ) ! O3+ISOP=0.066*HO2+0.266*OH+... + & + 0.800 * RXRAT( 160 ) ! NO3+ISOP=0.8*HO2+0.8*NTR+... + & + 0.154 * RXRAT( 162 ) ! O3+ISPD=0.154*HO2+0.268*OH+... + & + 0.925 * RXRAT( 163 ) ! NO3+ISPD=0.925*HO2+... + & + 1.033 * RXRAT( 164 ) ! ISPD=1.033*HO2+0.067*ALD2+... + & + 0.070 * RXRAT( 167 ) ! TERP+O3=0.07*HO2+0.57*OH+... + & + 0.280 * RXRAT( 168 ) ! TERP+NO3=0.28*HO2+0.47*NO2+... + & + 0.800 * RXRAT( 172 ) ! NO2+ISOP=0.8*HO2+0.8*NTR+... + & + RXRAT( 182 ) ! FMCL=HO2+CO+CL + & + 0.110 * RXRAT( 184 ) ! CL+PAR=0.11*HO2+0.87*XO2+... + & + RXRAT( 185 ) ! CL+ETHA=HO2+0.991*ALD2+... + & + RXRAT( 186 ) ! CL+ETH=HO2+2*XO2+FMCL+FORM + & + RXRAT( 187 ) ! CL+OLE=HO2+0.33*ALD2+... + & + RXRAT( 188 ) ! CL+IOLE=HO2+0.7*FMCL+... + & + RXRAT( 189 ) ! CL+ISOP=HO2+XO2+0.15*HCL+... + & + RXRAT( 190 ) ! CL+FORM=HO2+HCL+CO + & + RXRAT( 193 ) ! CL+MEOH=HO2+HCL+FORM + & + RXRAT( 194 ) ! CL+ETOH=HO2+HCL+ALD2 + & + 0.880 * RXRAT( 196 ) ! CL+TOL=0.88*HO2+0.88*XO2+... + & + 0.840 * RXRAT( 197 ) ! CL+XYL=0.84*HO2+0.84*XO2+... + + P5 = YC0( HO2 ) + P5 * DTC + +c..Production of HONO from OH (r19,4 terms ) + + R19_4 = RKI( 24 ) * YC( NO ) * DTC ! OH+NO=HONO + +c..Remaining HONO production terms + P19 = 2.000 * RXRAT( 23 ) ! NO+NO2=2*HONO + + P19 = YC0( HONO ) + P19 * DTC + +c..Production of PNA from HO2 (r21,5 term ) + + R21_5 = RKI( 31 ) * YC( NO2 ) * DTC ! HO2+NO2=HNO4 + +c..Remaining PNA production terms + P21 = YC0( PNA ) + +c..OH loss terms not in R5_4 & R19_4 + L4 = RKI( 26 ) * YC( HONO ) ! OH+HONO=NO2 + & + RKI( 28 ) * YC( NO2 ) ! OH+NO2=HNO3 + & + RKI( 29 ) * YC( HNO3 ) ! OH+HNO3=NO3 + & + RKI( 33 ) * YC( PNA ) ! OH+PNA=NO2 + & + 2.000 * RKI( 41 ) * YC( OH ) ! OH+OH=O + & + 2.000 * RKI( 42 ) * YC( OH ) ! OH+OH=H2O2 + & + RKI( 43 ) * YC( HO2 ) ! OH+HO2= + & + RKI( 63 ) * YC( ROOH ) ! OH+ROOH=XO2+... + & + RKI( 66 ) ! OH=MEO2 + & + 0.700 * RKI( 70 ) * YC( MEPX ) ! OH+MEPX=0.3*HO2+... + & + RKI( 84 ) * YC( ALD2 ) ! OH+ALD2=C2O3 + & + RKI( 95 ) * YC( PACD ) ! OH+PACD=C2O3 + & + RKI( 97 ) * YC( AACD ) ! OH+AACD=MEO2 + & + RKI( 99 ) * YC( ALDX ) ! OH+ALDX=CXO3 + & + RKI( 106 ) * YC( PANX ) ! OH+PANX=ALD2+NO2 + & + 0.890 * RKI( 112 ) * YC( PAR ) ! OH+PAR=0.11*HO2+... + & + 0.050 * RKI( 117 ) * YC( OLE ) ! OH+OLE=0.95*HO2+... + & + 0.648 * RKI( 128 ) * YC( TOL ) ! OH+TOL=0.28*HO2+... + & + RKI( 135 ) * YC( CRON ) ! OH+CRON=CRNO + & + RKI( 142 ) * YC( CRPX ) ! OH+CRPX=CRN2 + & + RKI( 144 ) * YC( OPEN ) ! OH+OPEN=0.6*OPO3+... + & + RKI( 147 ) * YC( CAT1 ) ! OH+CAT1=CAO2 + & + 0.300 * RKI( 154 ) * YC( XYL ) ! OH+XYL=0.7*HO2+... + & + RKI( 155 ) * YC( MGLY ) ! OH+MGLY=XO2+C2O3 + & + 0.088 * RKI( 158 ) * YC( ISOP ) ! OH+ISOP=... + & + 0.497 * RKI( 161 ) * YC( ISPD ) ! OH+ISPD=... + & + 0.250 * RKI( 166 ) * YC( TERP ) ! OH+TERP=0.75*HO2+... + & + RKI( 181 ) * YC( FMCL ) ! OH+FMCL=CL+CO + & + RKI( 195 ) * YC( HCL ) ! OH+HCL=CL + + L4 = 1.0 + L4 * DTC + R5_4 + R19_4 + +c..HO2 loss terms not included in R4_5 & R21_5 (except for HO2+HO2 ) + L5 = RKI( 43 ) * YC( OH ) ! HO2+OH= + & + RKI( 48 ) * YC( NO3 ) ! HO2+NO3=HNO3 + & + RKI( 56 ) * YC( XO2 ) ! HO2+XO2=ROOH + & + RKI( 57 ) * YC( XO2N ) ! HO2+XO2N=ROOH + & + RKI( 68 ) * YC( MEO2 ) ! HO2+MEO2=MEPX + & + RKI( 78 ) * YC( FORM ) ! HO2+FORM=HCO3 + & + RKI( 81 ) * YC( HCO3 ) ! HO2+HCO3=MEPX + & + RKI( 91 ) * YC( C2O3 ) ! HO2+C2O3=... + & + RKI( 107 ) * YC( CXO3 ) ! HO2+CXO3=... + & + RKI( 130 ) * YC( TO2 ) ! HO2+TO2= + & + RKI( 134 ) * YC( CRO ) ! HO2+CRO=CRES + & + RKI( 140 ) * YC( CRN2 ) ! HO2+CRN2=CRPX + & + RKI( 150 ) * YC( CAO2 ) ! HO2+CAO2= + & + RKI( 180 ) * YC( CLO ) ! HO2+CLO=HOCL + + L5 = 1.0 + L5 * DTC + R4_5 + R21_5 + +c..HONO loss terms not included in R4_19 + L19 = RKI( 26 ) * YC( OH ) ! HONO+OH=NO2 + & + 2.000 * RKI( 27 ) * YC( HONO ) ! HONO+HONO=NO+NO2 + + L19 = 1.0 + L19 * DTC + R4_19 + +c..PNA loss terms not inluded in R5_21 + L21 = RKI( 33 ) * YC( OH ) ! PNA+OH=NO2 + & + 0.390 * RKI( 51 ) ! PNA=0.61*HO2+... + + L21 = 1.0 + L21 * DTC + R5_21 + +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Solution section +ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + +c..compute terms used to calculate a,b & c + L21_INV = 1.0 / L21 + T1 = 1.0 / ( L4 * L19 - R4_19 * R19_4 ) + T2 = R5_4 * T1 + T3 = R5_21 * L21_INV + +c..solve quadratic equation for HO2 + A = 2.0 * ( RKI( 34 ) + RKI( 35 ) ) * DTC + + B = L5 - T3 * R21_5 - T2 * R4_5 * L19 + + C = P5 + T3 * P21 + T2 * ( P4 * L19 + P19 * R4_19 ) + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B + 4.0 * A * C ) ) + + YCP( HO2 ) = MAX( Q / A , -C / Q ) + +c..compute remaining species concentrations + YCP( OH ) = ( ( P4 + R4_5 * YCP( HO2 ) ) * L19 + R4_19 * P19 ) * T1 + + YCP( PNA ) = ( P21 + R21_5 * YCP( HO2 ) ) * L21_INV + + YCP( HONO ) = ( P19 + R19_4 * YCP( OH ) ) / L19 + + RETURN + + END + + diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrg3.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg3.F new file mode 100755 index 0000000..7af484a --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg3.F @@ -0,0 +1,120 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrg3.F,v 1.2 2011/10/21 16:10:53 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG3( DTC ) + +C********************************************************************** +C +C FUNCTION: To solve for the concentration of C2O3 and PAN +C +C PRECONDITIONS: For the CB05TUCL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 21, 2011 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + +C..INCLUDES: NONE + +C..ARGUMENTS: + REAL DTC ! Time step + + +C..PARAMETERS: NONE + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG3' ! Program name + + +C..SCRATCH LOCAL VARIABLES: + REAL A, B, C, Q ! Quadratic equation terms + REAL CMN ! Temp scalar + REAL L8 ! Loss of CCO_O2 + REAL L9 ! Loss of PAN + REAL P8 ! Production of CCO_O2 + + REAL K8_8 ! Kc2o3+c2o3 * delta t + REAL R8_9 ! Kpan-->c2o3 * delta t + REAL R9_8 ! Kc2o3+no2-->pan * [NO2] * delta t + +C********************************************************************** + + +c..Production of C2O3 (except from PAN ) + P8 = RXRAT( 83 ) ! ALD2+O=C2O3+OH + & + RXRAT( 84 ) ! ALD2+OH=C2O3 + & + RXRAT( 85 ) ! ALD2+NO3=C2O3+HNO3 + & + RXRAT( 95 ) ! PACD+OH=C2O3 + & + RXRAT( 155 ) ! OH+MGLY=C2O3+XO2 + & + RXRAT( 156 ) ! MGLY=C2O3+HO2+CO + & + 0.210 * RXRAT( 161 ) ! OH+ISPD=0.21*C2O3+... + & + 0.114 * RXRAT( 162 ) ! O3+ISPD=0.114*C2O3+... + & + 0.967 * RXRAT( 164 ) ! ISPD=0.967*C2O3+0.067*ALD2+... + & + RXRAT( 191 ) ! CL+ALD2=C2O3+HCL + +c..Loss frequency of C2O3 ( not including C2O3 + C2O3 ) + L8 = RKI( 87 ) * YC( NO ) ! C2O3+NO=MEO2+NO2 + & + RKI( 88 ) * YC( NO2 ) ! C2O3+NO2=PAN + & + RKI( 91 ) * YC( HO2 ) ! C2O3+HO2=... + & + RKI( 92 ) * YC( MEO2 ) ! C2O3+MEO2=... + & + RKI( 93 ) * YC( XO2 ) ! C2O3+XO2=... + & + RKI( 111 ) * YC( CXO3 ) ! C2O3+CXO3=MEO2+... + +c..Loss frequency of PAN + L9 = RKI( 89 ) ! PAN=C2O3+NO2 + & + RKI( 90 ) ! PAN=C2O3+NO2 + +c..K8_8, R8_9, and R9_8 terms + K8_8 = RKI( 94 ) * DTC + + R8_9 = ( RKI( 89 ) + & + RKI( 90 ) ) * DTC + + R9_8 = ( RKI( 88 ) * YC( NO2 ) ) * DTC + +c..Solution of quadratic equation to get C2O3 & PAN + CMN = 1.0 + L9 * DTC + A = 2.0 * K8_8 * CMN + B = CMN * ( 1.0 + L8 * DTC ) - R8_9 * R9_8 + C = CMN * ( YC0( C2O3 ) + P8 * DTC ) + R8_9 * YC0( PAN ) + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B + 4.0 * A * C ) ) + + YCP( C2O3 ) = MAX( Q / A , -C / Q ) + + YCP( PAN ) = ( YC0( PAN ) + R9_8 * YCP( C2O3 ) ) / CMN + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrg4.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg4.F new file mode 100755 index 0000000..631715a --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrg4.F @@ -0,0 +1,132 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrg4.F,v 1.2 2011/10/21 16:10:53 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRG4( DTC ) + +C********************************************************************** +C +C FUNCTION: To solve for the concentration of NO3 and N2O5 +C +C PRECONDITIONS: For the CB05TUCL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Jan. 21, 2011 +C +C********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C..INCLUDES: NONE + + +C..ARGUMENTS: + REAL DTC ! Time step + + +C..PARAMETERS: NONE + + +C..EXTERNAL FUNCTIONS: NONE + + +C..SAVED LOCAL VARIABLES: + CHARACTER( 16 ), SAVE :: PNAME = 'HRG4' ! Program name + + +C..SCRATCH LOCAL VARIABLES: + REAL A, B, C, Q ! Quadratic equation terms + REAL CMN ! Temp scalar + REAL L15 ! Loss of NO3 + REAL L16 ! Loss of N2O5 + REAL P15 ! Production of NO3 + REAL K15_15 ! Kno3+no3 * delta t + REAL R15_16 ! Kn2o5-->no3 * delta t + REAL R16_15 ! Kno3+no2-->n2o5[NO2] * delta t + + +C********************************************************************** + + +c..Production of NO3 (except from N2O5 ) + P15 = RXRAT( 5 ) ! O+NO2=NO3 + & + RXRAT( 7 ) ! NO2+O3=NO3 + & + RXRAT( 29 ) ! OH+HNO3=NO3 + & + 0.390 * RXRAT( 51 ) ! PNA=0.39*NO3+0.61*NO2+... + +c..Loss frequency of NO3 ( except NO3 + NO3 if present ) + L15 = RKI( 14 ) ! NO3=NO2+O + & + RKI( 15 ) ! NO3=NO + & + RKI( 16 ) * YC( NO ) ! NO3+NO=2*NO2 + & + RKI( 17 ) * YC( NO2 ) ! NO3+NO2=NO+NO2 + & + RKI( 18 ) * YC( NO2 ) ! NO3+NO2=N2O5 + & + RKI( 46 ) * YC( O ) ! NO3+O=NO2 + & + RKI( 47 ) * YC( OH ) ! NO3+OH=HO2+NO2 + & + RKI( 48 ) * YC( HO2 ) ! NO3+HO2=HNO3 + & + RKI( 49 ) * YC( O3 ) ! NO3+O3=NO2 + & + RKI( 77 ) * YC( FORM ) ! NO3+FORM=HNO3+HO2+CO + & + RKI( 85 ) * YC( ALD2 ) ! NO3+ALD2=C2O3+HNO3 + & + RKI( 100 ) * YC( ALDX ) ! NO3+ALDX=CXO3+HNO3 + & + RKI( 119 ) * YC( OLE ) ! NO3+OLE=NO2+FORM+... + & + RKI( 123 ) * YC( ETH ) ! NO3+ETH=NO2+XO2+... + & + RKI( 127 ) * YC( IOLE ) ! NO3+IOLE=... + & + RKI( 132 ) * YC( CRES ) ! NO3+CRES=0.3*CRO+... + & + RKI( 136 ) * YC( CRON ) ! NO3+CRON=CRNO+HNO3 + & + RKI( 146 ) * YC( OPEN ) ! NO3+OPEN=OPO3+HNO3 + & + RKI( 148 ) * YC( CAT1 ) ! NO3+CAT1=CRO+HNO3 + & + RKI( 160 ) * YC( ISOP ) ! NO3+ISOP=... + & + RKI( 163 ) * YC( ISPD ) ! NO3+ISPD=... + & + RKI( 168 ) * YC( TERP ) ! NO3+TERP=... + +c..Loss frequency of N2O5 + L16 = RKI( 19 ) ! N2O5=2*HNO3 + & + RKI( 20 ) ! N2O5=2*HNO3 + & + RKI( 21 ) ! N2O5=NO3+NO2 + & + RKI( 53 ) ! N2O5=NO2+NO3 + +c..K15_15, R15_16, and R16_15 terms + K15_15 = RKI( 50 ) * DTC + + R15_16 = ( RKI( 21 ) + & + RKI( 53 ) ) * DTC + + + R16_15 = RKI( 18 ) * YC( NO2 ) * DTC + +c..Solution of quadratic equation to get NO3 & N2O5 + CMN = 1.0 + L16 * DTC + A = 2.0 * K15_15 * CMN + B = CMN * ( 1.0 + L15 * DTC ) - R15_16 * R16_15 + C = CMN * ( YC0( NO3 ) + P15 * DTC ) + R15_16 * YC0( N2O5 ) + + Q = -0.5 * ( B + SIGN( 1.0, B ) * SQRT( B * B + 4.0 * A * C ) ) + YCP( NO3 ) = MAX( Q / A , -C / Q ) + YCP( N2O5 ) = ( YC0( N2O5 ) + R16_15 * YCP( NO3 ) ) / CMN + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrinit.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrinit.F new file mode 100755 index 0000000..bf288ab --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrinit.F @@ -0,0 +1,344 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrinit.F,v 1.3 2011/10/21 16:10:53 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HRINIT + +C----------------------------------------------------------------------- +C Function: To initialize species tolerances, arrays, and indices +C +C Preconditions: For the CB05TUCL family of mechanisms +C +C Return Values: None +C +C Key Subroutines/Functions Called: None +C +C Revision History: Created by EBI solver program, Jan. 21, 2011 +C 21 Jun 10 J.Young: convert for Namelist redesign +C 29 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE CGRID_SPCS, ONLY: N_GC_SPC ! CGRID mechanism species + USE UTILIO_DEFN + USE HRDATA + + IMPLICIT NONE + +C.....Includes: + INCLUDE SUBST_RXCMMN ! Mechanism reaction common block + +C.....Arguments: NONE + +C.....Parameters: NONE + +C.....External Functions: + INTEGER FINDEX ! Finds location of a number in a list + +C.....Saved Variables: + CHARACTER( 16 ), SAVE :: PNAME = 'HRINIT' ! Program name + +C.....Local Variables: + CHARACTER( 132 ) :: MSG = ' ' ! Log message + + INTEGER IND ! Species index + INTEGER N ! Loop index + INTEGER IOS ! Allocate error status + +C----------------------------------------------------------------------- + + N_SPEC = N_GC_SPC + N_RXNS = NRXNS + N_SPCL_RKS = 0 + + ALLOCATE( RKI( NRXNS ), + & RXRAT( NRXNS ), + & RTOL( N_SPEC), + & YC( N_SPEC), + & YC0( N_SPEC), + & YCP( N_SPEC), + & PROD( N_SPEC), + & LOSS( N_SPEC), + & PNEG( N_SPEC), STAT = IOS ) + IF ( IOS .NE. 0 ) THEN + MSG = 'Error allocating RKI, RXRAT, RTOL, YC, YC0, YCP, PROD, LOSS, or PNEG' + CALL M3EXIT( PNAME, 0, 0, MSG, XSTAT1 ) + END IF + + NING1 = 4 + NING2 = 4 + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set species indices and pointers +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + NO2 = 1 + NO = 2 + O = 3 + O3 = 4 + NO3 = 5 + O1D = 6 + OH = 7 + HO2 = 8 + N2O5 = 9 + HNO3 = 10 + HONO = 11 + PNA = 12 + H2O2 = 13 + XO2 = 14 + XO2N = 15 + NTR = 16 + ROOH = 17 + FORM = 18 + ALD2 = 19 + ALDX = 20 + PAR = 21 + CO = 22 + MEO2 = 23 + MEPX = 24 + MEOH = 25 + HCO3 = 26 + FACD = 27 + C2O3 = 28 + PAN = 29 + PACD = 30 + AACD = 31 + CXO3 = 32 + PANX = 33 + ROR = 34 + OLE = 35 + ETH = 36 + IOLE = 37 + TOL = 38 + CRES = 39 + TO2 = 40 + TOLRO2 = 41 + OPEN = 42 + MGLY = 43 + CRO = 44 + CAT1 = 45 + CRON = 46 + CRNO = 47 + CRN2 = 48 + CRPX = 49 + OPO3 = 50 + CAO2 = 51 + OPAN = 52 + XYL = 53 + XYLRO2 = 54 + ISOP = 55 + ISPD = 56 + ISOPRXN = 57 + TERP = 58 + TRPRXN = 59 + SO2 = 60 + SULF = 61 + SULRXN = 62 + ETOH = 63 + ETHA = 64 + RN = 65 + RN2 = 66 + CL2 = 67 + CL = 68 + HOCL = 69 + CLO = 70 + FMCL = 71 + HCL = 72 + TOLNRXN = 73 + TOLHRXN = 74 + XYLNRXN = 75 + XYLHRXN = 76 + BENZENE = 77 + BENZRO2 = 78 + BNZNRXN = 79 + BNZHRXN = 80 + SESQ = 81 + SESQRXN = 82 + +c..Allocate and define ebi species + N_EBISP = 69 + ALLOCATE( EBISP( N_EBISP ), STAT = IOS ) + IF ( IOS .NE. 0 ) THEN + MSG = 'Error allocating EBISP' + CALL M3EXIT( PNAME, 0, 0, MSG, XSTAT1 ) + END IF + + EBISP( 1 ) = HNO3 + EBISP( 2 ) = H2O2 + EBISP( 3 ) = XO2 + EBISP( 4 ) = XO2N + EBISP( 5 ) = NTR + EBISP( 6 ) = ROOH + EBISP( 7 ) = FORM + EBISP( 8 ) = ALD2 + EBISP( 9 ) = ALDX + EBISP( 10 ) = PAR + EBISP( 11 ) = CO + EBISP( 12 ) = MEO2 + EBISP( 13 ) = MEPX + EBISP( 14 ) = MEOH + EBISP( 15 ) = HCO3 + EBISP( 16 ) = FACD + EBISP( 17 ) = PACD + EBISP( 18 ) = AACD + EBISP( 19 ) = CXO3 + EBISP( 20 ) = PANX + EBISP( 21 ) = ROR + EBISP( 22 ) = OLE + EBISP( 23 ) = ETH + EBISP( 24 ) = IOLE + EBISP( 25 ) = TOL + EBISP( 26 ) = CRES + EBISP( 27 ) = TO2 + EBISP( 28 ) = TOLRO2 + EBISP( 29 ) = OPEN + EBISP( 30 ) = MGLY + EBISP( 31 ) = CRO + EBISP( 32 ) = CAT1 + EBISP( 33 ) = CRON + EBISP( 34 ) = CRNO + EBISP( 35 ) = CRN2 + EBISP( 36 ) = CRPX + EBISP( 37 ) = OPO3 + EBISP( 38 ) = CAO2 + EBISP( 39 ) = OPAN + EBISP( 40 ) = XYL + EBISP( 41 ) = XYLRO2 + EBISP( 42 ) = ISOP + EBISP( 43 ) = ISPD + EBISP( 44 ) = ISOPRXN + EBISP( 45 ) = TERP + EBISP( 46 ) = TRPRXN + EBISP( 47 ) = SO2 + EBISP( 48 ) = SULF + EBISP( 49 ) = SULRXN + EBISP( 50 ) = ETOH + EBISP( 51 ) = ETHA + EBISP( 52 ) = RN + EBISP( 53 ) = RN2 + EBISP( 54 ) = CL2 + EBISP( 55 ) = CL + EBISP( 56 ) = HOCL + EBISP( 57 ) = CLO + EBISP( 58 ) = FMCL + EBISP( 59 ) = HCL + EBISP( 60 ) = TOLNRXN + EBISP( 61 ) = TOLHRXN + EBISP( 62 ) = XYLNRXN + EBISP( 63 ) = XYLHRXN + EBISP( 64 ) = BENZENE + EBISP( 65 ) = BENZRO2 + EBISP( 66 ) = BNZNRXN + EBISP( 67 ) = BNZHRXN + EBISP( 68 ) = SESQ + EBISP( 69 ) = SESQRXN + + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Set species tolerances +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + RTOL( NO2 ) = 1.0E-03 + RTOL( NO ) = 1.0E-03 + RTOL( O ) = 1.0E+00 + RTOL( O3 ) = 1.0E-03 + RTOL( NO3 ) = 1.0E-03 + RTOL( O1D ) = 1.0E+00 + RTOL( OH ) = 1.0E-03 + RTOL( HO2 ) = 1.0E-03 + RTOL( N2O5 ) = 1.0E-03 + RTOL( HNO3 ) = 1.0E-03 + RTOL( HONO ) = 1.0E-03 + RTOL( PNA ) = 1.0E-03 + RTOL( H2O2 ) = 1.0E-03 + RTOL( XO2 ) = 1.0E-03 + RTOL( XO2N ) = 1.0E-03 + RTOL( NTR ) = 1.0E+00 + RTOL( ROOH ) = 1.0E-03 + RTOL( FORM ) = 1.0E-03 + RTOL( ALD2 ) = 1.0E-03 + RTOL( ALDX ) = 1.0E-03 + RTOL( PAR ) = 1.0E-03 + RTOL( CO ) = 1.0E-03 + RTOL( MEO2 ) = 1.0E-03 + RTOL( MEPX ) = 1.0E-03 + RTOL( MEOH ) = 1.0E-03 + RTOL( HCO3 ) = 1.0E+00 + RTOL( FACD ) = 1.0E-03 + RTOL( C2O3 ) = 1.0E-03 + RTOL( PAN ) = 1.0E-03 + RTOL( PACD ) = 1.0E-03 + RTOL( AACD ) = 1.0E-03 + RTOL( CXO3 ) = 1.0E-03 + RTOL( PANX ) = 1.0E-03 + RTOL( ROR ) = 1.0E-03 + RTOL( OLE ) = 1.0E-03 + RTOL( ETH ) = 1.0E-03 + RTOL( IOLE ) = 1.0E-03 + RTOL( TOL ) = 1.0E-03 + RTOL( CRES ) = 1.0E-03 + RTOL( TO2 ) = 1.0E-03 + RTOL( TOLRO2 ) = 1.0E-03 + RTOL( OPEN ) = 1.0E-03 + RTOL( MGLY ) = 1.0E-03 + RTOL( CRO ) = 1.0E-03 + RTOL( CAT1 ) = 1.0E-03 + RTOL( CRON ) = 1.0E-03 + RTOL( CRNO ) = 1.0E-03 + RTOL( CRN2 ) = 1.0E-03 + RTOL( CRPX ) = 1.0E-03 + RTOL( OPO3 ) = 1.0E-03 + RTOL( CAO2 ) = 1.0E-03 + RTOL( OPAN ) = 1.0E-03 + RTOL( XYL ) = 1.0E-03 + RTOL( XYLRO2 ) = 1.0E-03 + RTOL( ISOP ) = 1.0E-03 + RTOL( ISPD ) = 1.0E-03 + RTOL( ISOPRXN ) = 1.0E+00 + RTOL( TERP ) = 1.0E-03 + RTOL( TRPRXN ) = 1.0E+00 + RTOL( SO2 ) = 1.0E-03 + RTOL( SULF ) = 1.0E+00 + RTOL( SULRXN ) = 1.0E+00 + RTOL( ETOH ) = 1.0E-03 + RTOL( ETHA ) = 1.0E-03 + RTOL( RN ) = 1.0E-03 + RTOL( RN2 ) = 1.0E-03 + RTOL( CL2 ) = 1.0E-03 + RTOL( CL ) = 1.0E-03 + RTOL( HOCL ) = 1.0E-03 + RTOL( CLO ) = 1.0E-03 + RTOL( FMCL ) = 1.0E-03 + RTOL( HCL ) = 1.0E-03 + RTOL( TOLNRXN ) = 1.0E+00 + RTOL( TOLHRXN ) = 1.0E+00 + RTOL( XYLNRXN ) = 1.0E+00 + RTOL( XYLHRXN ) = 1.0E+00 + RTOL( BENZENE ) = 1.0E-03 + RTOL( BENZRO2 ) = 1.0E-03 + RTOL( BNZNRXN ) = 1.0E+00 + RTOL( BNZHRXN ) = 1.0E+00 + RTOL( SESQ ) = 1.0E-03 + RTOL( SESQRXN ) = 1.0E+00 + + RETURN + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrprodloss.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrprodloss.F new file mode 100755 index 0000000..38e8f61 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrprodloss.F @@ -0,0 +1,700 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrprodloss.F,v 1.4 2011/10/21 16:10:53 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRPRODLOSS + +C*********************************************************************** +C +C FUNCTION: To compute the production and loss rates for EBI species +C +C PRECONDITIONS: For the CB05TUCL family of mechanisms +C +C RETURN VALUES: None +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Sept. 12, 2011 +C +C*********************************************************************** + USE HRDATA + + IMPLICIT NONE + + +C.....INCLUDES: NONE + + +C.....ARGUMENTS: NONE + + +C.....PARAMETERS: NONE + + +C.....EXTERNAL FUNCTIONS: NONE + + +C.....SAVED VARIABLES: NONE + CHARACTER( 16 ), SAVE :: PNAME = 'HRPRODLOSS' ! Program name + + +C.....LOCAL VARIABLES: + + INTEGER ESP + +C*********************************************************************** + + + PROD( HNO3 ) = 2.000 * RXRAT( 19 ) ! N2O5=2*HNO3 + & + 2.000 * RXRAT( 20 ) ! N2O5=2*HNO3 + & + RXRAT( 28 ) ! NO2+OH=HNO3 + & + RXRAT( 48 ) ! NO3+HO2=HNO3 + & + RXRAT( 61 ) ! NTR+OH=HNO3+HO2+0.33*FORM+... + & + RXRAT( 77 ) ! FORM+NO3=HNO3+HO2+CO + & + RXRAT( 85 ) ! ALD2+NO3=HNO3+C2O3 + & + RXRAT( 100 ) ! ALDX+NO3=HNO3+CXO3 + & + RXRAT( 132 ) ! CRES+NO3=HNO3+0.3*CRO+... + & + RXRAT( 136 ) ! CRON+NO3=HNO3+CRNO + & + RXRAT( 146 ) ! OPEN+NO3=HNO3+OPO3 + & + RXRAT( 148 ) ! CAT1+NO3=HNO3+CRO + & + 0.150 * RXRAT( 163 ) ! NO3+ISPD=0.15*HNO3+... + LOSS( HNO3 ) = RXRAT( 29 ) ! HNO3+OH=NO3 + & + RXRAT( 52 ) ! HNO3=OH+NO2 + + PROD( H2O2 ) = RXRAT( 34 ) ! HO2+HO2=H2O2 + & + RXRAT( 35 ) ! HO2+HO2=H2O2 + & + RXRAT( 42 ) ! OH+OH=H2O2 + LOSS( H2O2 ) = RXRAT( 36 ) ! H2O2=2*OH + & + RXRAT( 37 ) ! H2O2+OH=HO2 + & + RXRAT( 45 ) ! H2O2+O=OH+HO2 + + PROD( XO2 ) = RXRAT( 63 ) ! ROOH+OH=XO2+0.5*ALD2+0.5*ALDX + & + 0.300 * RXRAT( 70 ) ! MEPX+OH=0.3*XO2+0.7*MEO2+... + & + RXRAT( 102 ) ! CXO3+NO=XO2+NO2+HO2+ALD2 + & + 0.900 * RXRAT( 108 ) ! CXO3+MEO2=0.9*XO2+0.9*ALD2+... + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*XO2+2*ALD2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=XO2+MEO2+HO2+ALD2 + & + 0.870 * RXRAT( 112 ) ! PAR+OH=0.87*XO2+0.13*XO2N+... + & + 0.960 * RXRAT( 113 ) ! ROR=0.96*XO2+0.6*ALD2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*XO2+0.3*ALDX+... + & + 0.800 * RXRAT( 117 ) ! OH+OLE=0.8*XO2+0.33*ALD2+... + & + 0.220 * RXRAT( 118 ) ! O3+OLE=0.22*XO2+0.74*FORM+... + & + 0.910 * RXRAT( 119 ) ! NO3+OLE=0.91*XO2+FORM+NO2+... + & + 0.700 * RXRAT( 120 ) ! O+ETH=0.7*XO2+1.7*HO2+CO+... + & + RXRAT( 121 ) ! OH+ETH=XO2+1.56*FORM+... + & + RXRAT( 123 ) ! NO3+ETH=XO2+NO2+2*FORM + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*XO2+0.66*ALDX+... + & + RXRAT( 125 ) ! IOLE+OH=XO2+0.7*ALDX+HO2+... + & + 0.100 * RXRAT( 128 ) ! TOL+OH=0.1*XO2+0.28*HO2+... + & + 0.120 * RXRAT( 131 ) ! OH+CRES=0.12*XO2+0.06*CRO+... + & + 0.600 * RXRAT( 132 ) ! CRES+NO3=0.6*XO2+HNO3+... + & + 0.030 * RXRAT( 145 ) ! OPEN+O3=0.03*XO2+0.62*OPO3+... + & + RXRAT( 151 ) ! OPO3+NO=XO2+NO2+HO2+ALDX + & + 0.500 * RXRAT( 154 ) ! OH+XYL=0.5*XO2+0.7*HO2+... + & + RXRAT( 155 ) ! OH+MGLY=XO2+C2O3 + & + 0.250 * RXRAT( 157 ) ! O+ISOP=0.25*XO2+0.5*FORM+... + & + 0.991 * RXRAT( 158 ) ! OH+ISOP=0.991*XO2+... + & + 0.200 * RXRAT( 159 ) ! O3+ISOP=0.2*XO2+0.6*FORM+... + & + RXRAT( 160 ) ! NO3+ISOP=XO2+0.8*NTR+... + & + 0.713 * RXRAT( 161 ) ! OH+ISPD=0.713*XO2+... + & + 0.064 * RXRAT( 162 ) ! O3+ISPD=0.064*XO2+... + & + 0.075 * RXRAT( 163 ) ! NO3+ISPD=0.075*XO2+... + & + 0.700 * RXRAT( 164 ) ! ISPD=0.7*XO2+0.067*ALD2+... + & + 1.250 * RXRAT( 166 ) ! TERP+OH=1.25*XO2+0.75*HO2+... + & + 0.760 * RXRAT( 167 ) ! TERP+O3=0.76*XO2+0.07*HO2+... + & + 1.030 * RXRAT( 168 ) ! TERP+NO3=1.03*XO2+0.28*HO2+... + & + 0.100 * RXRAT( 170 ) ! OH+ETOH=0.1*XO2+0.9*ALD2+... + & + 0.991 * RXRAT( 171 ) ! OH+ETHA=0.991*XO2+... + & + RXRAT( 172 ) ! NO2+ISOP=XO2+0.8*NTR+... + & + 0.870 * RXRAT( 184 ) ! CL+PAR=0.87*XO2+HCL+... + & + 0.991 * RXRAT( 185 ) ! CL+ETHA=0.991*XO2+... + & + 2.000 * RXRAT( 186 ) ! CL+ETH=2*XO2+FMCL+HO2+FORM + & + 2.000 * RXRAT( 187 ) ! CL+OLE=2*XO2+0.33*ALD2+... + & + 1.700 * RXRAT( 188 ) ! CL+IOLE=1.7*XO2+0.7*FMCL+... + & + RXRAT( 189 ) ! CL+ISOP=XO2+0.15*HCL+HO2+... + & + 0.880 * RXRAT( 196 ) ! CL+TOL=0.88*XO2+HCL+... + & + 0.840 * RXRAT( 197 ) ! CL+XYL=0.84*XO2+HCL+... + LOSS( XO2 ) = RXRAT( 54 ) ! XO2+NO=NO2 + & + RXRAT( 56 ) ! XO2+HO2=ROOH + & + 2.000 * RXRAT( 58 ) ! XO2+XO2= + & + RXRAT( 60 ) ! XO2+XO2N= + & + RXRAT( 93 ) ! XO2+C2O3=0.9*MEO2+0.1*AACD + & + RXRAT( 109 ) ! XO2+CXO3=0.9*ALD2+0.1*AACD + + PROD( XO2N ) = 0.130 * RXRAT( 112 ) ! PAR+OH=0.13*XO2N+0.87*XO2+... + & + 0.040 * RXRAT( 113 ) ! ROR=0.04*XO2N+0.6*ALD2+... + & + 0.010 * RXRAT( 116 ) ! O+OLE=0.01*XO2N+0.3*ALDX+... + & + 0.090 * RXRAT( 119 ) ! NO3+OLE=0.09*XO2N+FORM+... + & + 0.060 * RXRAT( 131 ) ! OH+CRES=0.06*XO2N+0.12*XO2+... + & + 0.100 * RXRAT( 132 ) ! CRES+NO3=0.1*XO2N+HNO3+... + & + 0.088 * RXRAT( 158 ) ! OH+ISOP=0.088*XO2N+... + & + 0.250 * RXRAT( 166 ) ! TERP+OH=0.25*XO2N+1.25*XO2+... + & + 0.180 * RXRAT( 167 ) ! TERP+O3=0.18*XO2N+0.07*HO2+... + & + 0.250 * RXRAT( 168 ) ! TERP+NO3=0.25*XO2N+... + & + 0.009 * RXRAT( 171 ) ! OH+ETHA=0.009*XO2N+... + & + 0.130 * RXRAT( 184 ) ! CL+PAR=0.13*XO2N+0.87*XO2+... + & + 0.009 * RXRAT( 185 ) ! CL+ETHA=0.009*XO2N+... + & + 0.120 * RXRAT( 196 ) ! CL+TOL=0.12*XO2N+0.88*XO2+... + & + 0.160 * RXRAT( 197 ) ! CL+XYL=0.16*XO2N+0.84*XO2+... + LOSS( XO2N ) = RXRAT( 55 ) ! XO2N+NO=NTR + & + RXRAT( 57 ) ! XO2N+HO2=ROOH + & + 2.000 * RXRAT( 59 ) ! XO2N+XO2N= + & + RXRAT( 60 ) ! XO2N+XO2= + + PROD( NTR ) = RXRAT( 55 ) ! XO2N+NO=NTR + & + RXRAT( 115 ) ! ROR+NO2=NTR + & + 0.140 * RXRAT( 129 ) ! TO2+NO=0.14*NTR+1.2*HO2+... + & + 2.000 * RXRAT( 137 ) ! CRNO+NO2=2*NTR + & + 0.140 * RXRAT( 149 ) ! CAO2+NO=0.14*NTR+1.2*HO2+... + & + 0.800 * RXRAT( 160 ) ! NO3+ISOP=0.8*NTR+0.2*ISPD+... + & + 0.850 * RXRAT( 163 ) ! NO3+ISPD=0.85*NTR+... + & + 0.530 * RXRAT( 168 ) ! TERP+NO3=0.53*NTR+0.28*HO2+... + & + 0.800 * RXRAT( 172 ) ! NO2+ISOP=0.8*NTR+0.2*ISPD+... + LOSS( NTR ) = RXRAT( 61 ) ! NTR+OH=HNO3+HO2+0.33*FORM+... + & + RXRAT( 62 ) ! NTR=NO2+HO2+0.33*FORM+... + + PROD( ROOH ) = RXRAT( 56 ) ! XO2+HO2=ROOH + & + RXRAT( 57 ) ! XO2N+HO2=ROOH + LOSS( ROOH ) = RXRAT( 63 ) ! ROOH+OH=XO2+0.5*ALD2+0.5*ALDX + & + RXRAT( 64 ) ! ROOH=OH+HO2+0.5*ALD2+0.5*ALDX + + PROD( FORM ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*FORM+HO2+HNO3+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*FORM+HO2+NO2+... + & + RXRAT( 67 ) ! MEO2+NO=FORM+HO2+NO2 + & + 1.370 * RXRAT( 69 ) ! MEO2+MEO2=1.37*FORM+... + & + RXRAT( 71 ) ! MEPX=FORM+HO2+OH + & + RXRAT( 72 ) ! MEOH+OH=FORM+HO2 + & + RXRAT( 79 ) ! HCO3=FORM+HO2 + & + RXRAT( 92 ) ! C2O3+MEO2=FORM+0.9*HO2+... + & + 0.100 * RXRAT( 108 ) ! CXO3+MEO2=0.1*FORM+0.9*XO2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*FORM+0.3*ALDX+... + & + 0.800 * RXRAT( 117 ) ! OH+OLE=0.8*FORM+0.33*ALD2+... + & + 0.740 * RXRAT( 118 ) ! O3+OLE=0.74*FORM+0.18*ALD2+... + & + RXRAT( 119 ) ! NO3+OLE=FORM+NO2+0.91*XO2+... + & + RXRAT( 120 ) ! O+ETH=FORM+1.7*HO2+CO+... + & + 1.560 * RXRAT( 121 ) ! OH+ETH=1.56*FORM+XO2+... + & + RXRAT( 122 ) ! O3+ETH=FORM+0.63*CO+... + & + 2.000 * RXRAT( 123 ) ! NO3+ETH=2*FORM+XO2+NO2 + & + 0.250 * RXRAT( 126 ) ! IOLE+O3=0.25*FORM+... + & + 0.336 * RXRAT( 129 ) ! TO2+NO=0.336*FORM+1.2*HO2+... + & + 0.060 * RXRAT( 131 ) ! OH+CRES=0.06*FORM+0.12*XO2+... + & + 0.240 * RXRAT( 132 ) ! CRES+NO3=0.24*FORM+HNO3+... + & + 0.700 * RXRAT( 145 ) ! OPEN+O3=0.7*FORM+0.62*OPO3+... + & + 0.344 * RXRAT( 149 ) ! CAO2+NO=0.344*FORM+1.2*HO2+... + & + 0.500 * RXRAT( 157 ) ! O+ISOP=0.5*FORM+0.75*ISPD+... + & + 0.629 * RXRAT( 158 ) ! OH+ISOP=0.629*FORM+... + & + 0.600 * RXRAT( 159 ) ! O3+ISOP=0.6*FORM+0.65*ISPD+... + & + 0.167 * RXRAT( 161 ) ! OH+ISPD=0.167*FORM+... + & + 0.150 * RXRAT( 162 ) ! O3+ISPD=0.15*FORM+... + & + 0.282 * RXRAT( 163 ) ! NO3+ISPD=0.282*FORM+... + & + 0.900 * RXRAT( 164 ) ! ISPD=0.9*FORM+0.067*ALD2+... + & + 0.280 * RXRAT( 166 ) ! TERP+OH=0.28*FORM+1.25*XO2+... + & + 0.240 * RXRAT( 167 ) ! TERP+O3=0.24*FORM+0.07*HO2+... + & + 0.100 * RXRAT( 170 ) ! OH+ETOH=0.1*FORM+0.9*ALD2+... + & + RXRAT( 186 ) ! CL+ETH=FORM+2*XO2+HO2+FMCL + & + RXRAT( 193 ) ! CL+MEOH=FORM+HO2+HCL + LOSS( FORM ) = RXRAT( 73 ) ! FORM+OH=HO2+CO + & + RXRAT( 74 ) ! FORM=2*HO2+CO + & + RXRAT( 75 ) ! FORM=CO + & + RXRAT( 76 ) ! FORM+O=OH+HO2+CO + & + RXRAT( 77 ) ! FORM+NO3=HNO3+HO2+CO + & + RXRAT( 78 ) ! FORM+HO2=HCO3 + & + RXRAT( 190 ) ! FORM+CL=HCL+HO2+CO + + PROD( ALD2 ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*ALD2+HO2+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*ALD2+HO2+... + & + 0.500 * RXRAT( 63 ) ! ROOH+OH=0.5*ALD2+XO2+0.5*ALDX + & + 0.500 * RXRAT( 64 ) ! ROOH=0.5*ALD2+HO2+OH+0.5*ALDX + & + RXRAT( 102 ) ! CXO3+NO=ALD2+NO2+HO2+XO2 + & + RXRAT( 106 ) ! PANX+OH=ALD2+NO2 + & + 0.900 * RXRAT( 108 ) ! CXO3+MEO2=0.9*ALD2+0.9*XO2+... + & + 0.900 * RXRAT( 109 ) ! CXO3+XO2=0.9*ALD2+0.1*AACD + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*ALD2+2*XO2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=ALD2+XO2+HO2+MEO2 + & + 0.060 * RXRAT( 112 ) ! PAR+OH=0.06*ALD2+0.13*XO2N+... + & + 0.600 * RXRAT( 113 ) ! ROR=0.6*ALD2+0.96*XO2+... + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*ALD2+0.3*ALDX+... + & + 0.330 * RXRAT( 117 ) ! OH+OLE=0.33*ALD2+0.8*FORM+... + & + 0.180 * RXRAT( 118 ) ! O3+OLE=0.18*ALD2+0.74*FORM+... + & + 0.350 * RXRAT( 119 ) ! NO3+OLE=0.35*ALD2+FORM+... + & + 1.240 * RXRAT( 124 ) ! IOLE+O=1.24*ALD2+0.66*ALDX+... + & + 1.300 * RXRAT( 125 ) ! IOLE+OH=1.3*ALD2+0.7*ALDX+... + & + 0.650 * RXRAT( 126 ) ! IOLE+O3=0.65*ALD2+... + & + 1.180 * RXRAT( 127 ) ! IOLE+NO3=1.18*ALD2+... + & + 0.252 * RXRAT( 161 ) ! OH+ISPD=0.252*ALD2+... + & + 0.020 * RXRAT( 162 ) ! O3+ISPD=0.02*ALD2+... + & + 0.067 * RXRAT( 164 ) ! ISPD=0.067*ALD2+0.333*CO+... + & + 0.900 * RXRAT( 170 ) ! OH+ETOH=0.9*ALD2+HO2+... + & + 0.991 * RXRAT( 171 ) ! OH+ETHA=0.991*ALD2+... + & + 0.060 * RXRAT( 184 ) ! CL+PAR=0.06*ALD2+0.87*XO2+... + & + 0.991 * RXRAT( 185 ) ! CL+ETHA=0.991*ALD2+HCL+... + & + 0.330 * RXRAT( 187 ) ! CL+OLE=0.33*ALD2+FMCL+... + & + 0.450 * RXRAT( 188 ) ! CL+IOLE=0.45*ALD2+0.7*FMCL+... + & + RXRAT( 194 ) ! CL+ETOH=ALD2+HO2+HCL + LOSS( ALD2 ) = RXRAT( 83 ) ! ALD2+O=C2O3+OH + & + RXRAT( 84 ) ! ALD2+OH=C2O3 + & + RXRAT( 85 ) ! ALD2+NO3=C2O3+HNO3 + & + RXRAT( 86 ) ! ALD2=MEO2+CO+HO2 + & + RXRAT( 191 ) ! ALD2+CL=HCL+C2O3 + + PROD( ALDX ) = 0.330 * RXRAT( 61 ) ! NTR+OH=0.33*ALDX+HO2+... + & + 0.330 * RXRAT( 62 ) ! NTR=0.33*ALDX+HO2+... + & + 0.500 * RXRAT( 63 ) ! ROOH+OH=0.5*ALDX+0.5*ALD2+XO2 + & + 0.500 * RXRAT( 64 ) ! ROOH=0.5*ALDX+HO2+0.5*ALD2+OH + & + 0.050 * RXRAT( 112 ) ! PAR+OH=0.05*ALDX+0.13*XO2N+... + & + 0.500 * RXRAT( 113 ) ! ROR=0.5*ALDX+0.6*ALD2+... + & + 0.300 * RXRAT( 116 ) ! O+OLE=0.3*ALDX+0.2*ALD2+... + & + 0.620 * RXRAT( 117 ) ! OH+OLE=0.62*ALDX+0.33*ALD2+... + & + 0.320 * RXRAT( 118 ) ! O3+OLE=0.32*ALDX+0.74*FORM+... + & + 0.560 * RXRAT( 119 ) ! NO3+OLE=0.56*ALDX+FORM+... + & + 0.220 * RXRAT( 121 ) ! OH+ETH=0.22*ALDX+1.56*FORM+... + & + 0.660 * RXRAT( 124 ) ! IOLE+O=0.66*ALDX+1.24*ALD2+... + & + 0.700 * RXRAT( 125 ) ! IOLE+OH=0.7*ALDX+1.3*ALD2+... + & + 0.350 * RXRAT( 126 ) ! IOLE+O3=0.35*ALDX+... + & + 0.640 * RXRAT( 127 ) ! IOLE+NO3=0.64*ALDX+... + & + 0.480 * RXRAT( 132 ) ! CRES+NO3=0.48*ALDX+HNO3+... + & + 0.030 * RXRAT( 145 ) ! OPEN+O3=0.03*ALDX+... + & + RXRAT( 151 ) ! OPO3+NO=ALDX+XO2+HO2+NO2 + & + 0.150 * RXRAT( 159 ) ! O3+ISOP=0.15*ALDX+0.6*FORM+... + & + 0.800 * RXRAT( 160 ) ! NO3+ISOP=0.8*ALDX+0.8*NTR+... + & + 0.120 * RXRAT( 161 ) ! OH+ISPD=0.12*ALDX+... + & + 0.357 * RXRAT( 163 ) ! NO3+ISPD=0.357*ALDX+... + & + 0.150 * RXRAT( 165 ) ! TERP+O=0.15*ALDX+5.12*PAR+... + & + 0.470 * RXRAT( 166 ) ! TERP+OH=0.47*ALDX+1.25*XO2+... + & + 0.210 * RXRAT( 167 ) ! TERP+O3=0.21*ALDX+0.07*HO2+... + & + 0.470 * RXRAT( 168 ) ! TERP+NO3=0.47*ALDX+... + & + 0.050 * RXRAT( 170 ) ! OH+ETOH=0.05*ALDX+0.9*ALD2+... + & + 0.800 * RXRAT( 172 ) ! NO2+ISOP=0.8*ALDX+0.8*NTR+... + & + 0.050 * RXRAT( 184 ) ! CL+PAR=0.05*ALDX+0.87*XO2+... + & + 0.670 * RXRAT( 187 ) ! CL+OLE=0.67*ALDX+0.33*ALD2+... + & + 0.550 * RXRAT( 188 ) ! CL+IOLE=0.55*ALDX+0.7*FMCL+... + LOSS( ALDX ) = RXRAT( 98 ) ! ALDX+O=CXO3+OH + & + RXRAT( 99 ) ! ALDX+OH=CXO3 + & + RXRAT( 100 ) ! ALDX+NO3=CXO3+HNO3 + & + RXRAT( 101 ) ! ALDX=MEO2+CO+HO2 + & + RXRAT( 192 ) ! ALDX+CL=HCL+CXO3 + + PROD( PAR ) = 0.200 * RXRAT( 116 ) ! O+OLE=0.2*PAR+0.3*ALDX+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*PAR+0.66*ALDX+... + & + 1.100 * RXRAT( 154 ) ! OH+XYL=1.1*PAR+0.5*XO2+... + & + 0.250 * RXRAT( 157 ) ! O+ISOP=0.25*PAR+0.5*FORM+... + & + 0.350 * RXRAT( 159 ) ! O3+ISOP=0.35*PAR+0.6*FORM+... + & + 2.400 * RXRAT( 160 ) ! NO3+ISOP=2.4*PAR+0.8*NTR+... + & + 1.565 * RXRAT( 161 ) ! OH+ISPD=1.565*PAR+... + & + 0.360 * RXRAT( 162 ) ! O3+ISPD=0.36*PAR+0.15*FORM+... + & + 1.282 * RXRAT( 163 ) ! NO3+ISPD=1.282*PAR+... + & + 0.832 * RXRAT( 164 ) ! ISPD=0.832*PAR+0.067*ALD2+... + & + 5.120 * RXRAT( 165 ) ! TERP+O=5.12*PAR+0.15*ALDX+... + & + 1.660 * RXRAT( 166 ) ! TERP+OH=1.66*PAR+1.25*XO2+... + & + 7.000 * RXRAT( 167 ) ! TERP+O3=7*PAR+0.07*HO2+... + & + 2.400 * RXRAT( 172 ) ! NO2+ISOP=2.4*PAR+0.8*NTR+... + & + 0.300 * RXRAT( 188 ) ! CL+IOLE=0.3*PAR+0.7*FMCL+... + LOSS( PAR ) = 0.660 * RXRAT( 61 ) ! NTR+OH=-0.66*PAR+HO2+... + & + 0.660 * RXRAT( 62 ) ! NTR=-0.66*PAR+HO2+... + & + 1.110 * RXRAT( 112 ) ! PAR+OH=-0.11*PAR+0.13*XO2N+... + & + 2.100 * RXRAT( 113 ) ! ROR=-2.1*PAR+0.6*ALD2+... + & + 0.700 * RXRAT( 117 ) ! OH+OLE=-0.7*PAR+0.33*ALD2+... + & + RXRAT( 118 ) ! O3+OLE=-PAR+0.74*FORM+... + & + RXRAT( 119 ) ! NO3+OLE=-PAR+FORM+0.91*XO2+... + & + 1.110 * RXRAT( 184 ) ! PAR+CL=-0.11*PAR+0.87*XO2+... + & + RXRAT( 187 ) ! CL+OLE=-PAR+0.33*ALD2+... + + PROD( CO ) = RXRAT( 73 ) ! FORM+OH=CO+HO2 + & + RXRAT( 74 ) ! FORM=CO+2*HO2 + & + RXRAT( 75 ) ! FORM=CO + & + RXRAT( 76 ) ! FORM+O=CO+HO2+OH + & + RXRAT( 77 ) ! FORM+NO3=CO+HO2+HNO3 + & + RXRAT( 86 ) ! ALD2=CO+MEO2+HO2 + & + RXRAT( 101 ) ! ALDX=CO+MEO2+HO2 + & + 0.200 * RXRAT( 116 ) ! O+OLE=0.2*CO+0.3*ALDX+... + & + 0.330 * RXRAT( 118 ) ! O3+OLE=0.33*CO+0.74*FORM+... + & + RXRAT( 120 ) ! O+ETH=CO+1.7*HO2+FORM+... + & + 0.630 * RXRAT( 122 ) ! O3+ETH=0.63*CO+FORM+... + & + 0.100 * RXRAT( 124 ) ! IOLE+O=0.1*CO+0.66*ALDX+... + & + 0.250 * RXRAT( 126 ) ! IOLE+O3=0.25*CO+0.35*ALDX+... + & + 0.336 * RXRAT( 129 ) ! TO2+NO=0.336*CO+1.2*HO2+... + & + 0.060 * RXRAT( 131 ) ! OH+CRES=0.06*CO+0.12*XO2+... + & + 0.240 * RXRAT( 132 ) ! CRES+NO3=0.24*CO+HNO3+... + & + RXRAT( 143 ) ! OPEN=CO+HO2+OPO3 + & + 0.690 * RXRAT( 145 ) ! OPEN+O3=0.69*CO+0.62*OPO3+... + & + 0.344 * RXRAT( 149 ) ! CAO2+NO=0.344*CO+1.2*HO2+... + & + RXRAT( 156 ) ! MGLY=CO+HO2+C2O3 + & + 0.066 * RXRAT( 159 ) ! O3+ISOP=0.066*CO+0.6*FORM+... + & + 0.334 * RXRAT( 161 ) ! OH+ISPD=0.334*CO+... + & + 0.225 * RXRAT( 162 ) ! O3+ISPD=0.225*CO+0.15*FORM+... + & + 0.643 * RXRAT( 163 ) ! NO3+ISPD=0.643*CO+... + & + 0.333 * RXRAT( 164 ) ! ISPD=0.333*CO+0.067*ALD2+... + & + 0.001 * RXRAT( 167 ) ! TERP+O3=0.001*CO+0.07*HO2+... + & + RXRAT( 181 ) ! OH+FMCL=CO+CL + & + RXRAT( 182 ) ! FMCL=CO+CL+HO2 + & + RXRAT( 190 ) ! CL+FORM=CO+HO2+HCL + LOSS( CO ) = RXRAT( 65 ) ! CO+OH=HO2 + + PROD( MEO2 ) = RXRAT( 66 ) ! OH=MEO2 + & + 0.700 * RXRAT( 70 ) ! MEPX+OH=0.7*MEO2+0.3*XO2+... + & + RXRAT( 86 ) ! ALD2=MEO2+CO+HO2 + & + RXRAT( 87 ) ! C2O3+NO=MEO2+NO2 + & + 0.900 * RXRAT( 93 ) ! C2O3+XO2=0.9*MEO2+0.1*AACD + & + 2.000 * RXRAT( 94 ) ! C2O3+C2O3=2*MEO2 + & + RXRAT( 96 ) ! PACD=MEO2+OH + & + RXRAT( 97 ) ! AACD+OH=MEO2 + & + RXRAT( 101 ) ! ALDX=MEO2+CO+HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=MEO2+XO2+HO2+ALD2 + & + RXRAT( 183 ) ! CL=MEO2+HCL + LOSS( MEO2 ) = RXRAT( 67 ) ! MEO2+NO=FORM+HO2+NO2 + & + RXRAT( 68 ) ! MEO2+HO2=MEPX + & + 2.000 * RXRAT( 69 ) ! MEO2+MEO2=1.37*FORM+... + & + 0.100 * RXRAT( 92 ) ! MEO2+C2O3=0.9*MEO2+0.9*HO2+... + & + RXRAT( 108 ) ! MEO2+CXO3=0.9*ALD2+0.9*XO2+... + + PROD( MEPX ) = RXRAT( 68 ) ! MEO2+HO2=MEPX + & + RXRAT( 81 ) ! HCO3+HO2=MEPX + LOSS( MEPX ) = RXRAT( 70 ) ! MEPX+OH=0.7*MEO2+0.3*XO2+... + & + RXRAT( 71 ) ! MEPX=FORM+HO2+OH + + PROD( MEOH ) = 0.630 * RXRAT( 69 ) ! MEO2+MEO2=0.63*MEOH+... + LOSS( MEOH ) = RXRAT( 72 ) ! MEOH+OH=FORM+HO2 + & + RXRAT( 193 ) ! MEOH+CL=HCL+HO2+FORM + + PROD( HCO3 ) = RXRAT( 78 ) ! FORM+HO2=HCO3 + LOSS( HCO3 ) = RXRAT( 79 ) ! HCO3=FORM+HO2 + & + RXRAT( 80 ) ! HCO3+NO=FACD+NO2+HO2 + & + RXRAT( 81 ) ! HCO3+HO2=MEPX + + PROD( FACD ) = RXRAT( 80 ) ! HCO3+NO=FACD+NO2+HO2 + & + 0.370 * RXRAT( 122 ) ! O3+ETH=0.37*FACD+0.63*CO+... + LOSS( FACD ) = RXRAT( 82 ) ! FACD+OH=HO2 + + PROD( PACD ) = 0.800 * RXRAT( 91 ) ! C2O3+HO2=0.8*PACD+0.2*AACD+... + & + 0.800 * RXRAT( 107 ) ! CXO3+HO2=0.8*PACD+0.2*AACD+... + LOSS( PACD ) = RXRAT( 95 ) ! PACD+OH=C2O3 + & + RXRAT( 96 ) ! PACD=MEO2+OH + + PROD( AACD ) = 0.200 * RXRAT( 91 ) ! C2O3+HO2=0.2*AACD+0.8*PACD+... + & + 0.100 * RXRAT( 92 ) ! C2O3+MEO2=0.1*AACD+0.9*HO2+... + & + 0.100 * RXRAT( 93 ) ! C2O3+XO2=0.1*AACD+0.9*MEO2 + & + 0.200 * RXRAT( 107 ) ! CXO3+HO2=0.2*AACD+0.8*PACD+... + & + 0.100 * RXRAT( 108 ) ! CXO3+MEO2=0.1*AACD+0.9*XO2+... + & + 0.100 * RXRAT( 109 ) ! CXO3+XO2=0.1*AACD+0.9*ALD2 + LOSS( AACD ) = RXRAT( 97 ) ! AACD+OH=MEO2 + + PROD( CXO3 ) = RXRAT( 98 ) ! ALDX+O=CXO3+OH + & + RXRAT( 99 ) ! ALDX+OH=CXO3 + & + RXRAT( 100 ) ! ALDX+NO3=CXO3+HNO3 + & + RXRAT( 104 ) ! PANX=CXO3+NO2 + & + RXRAT( 105 ) ! PANX=CXO3+NO2 + & + 0.250 * RXRAT( 157 ) ! O+ISOP=0.25*CXO3+0.5*FORM+... + & + 0.200 * RXRAT( 159 ) ! O3+ISOP=0.2*CXO3+0.6*FORM+... + & + 0.250 * RXRAT( 161 ) ! OH+ISPD=0.25*CXO3+... + & + 0.075 * RXRAT( 163 ) ! NO3+ISPD=0.075*CXO3+... + & + 0.390 * RXRAT( 167 ) ! TERP+O3=0.39*CXO3+0.07*HO2+... + & + RXRAT( 192 ) ! CL+ALDX=CXO3+HCL + LOSS( CXO3 ) = RXRAT( 102 ) ! CXO3+NO=ALD2+NO2+HO2+XO2 + & + RXRAT( 103 ) ! CXO3+NO2=PANX + & + RXRAT( 107 ) ! CXO3+HO2=0.8*PACD+0.2*AACD+... + & + RXRAT( 108 ) ! CXO3+MEO2=0.9*ALD2+0.9*XO2+... + & + RXRAT( 109 ) ! CXO3+XO2=0.9*ALD2+0.1*AACD + & + 2.000 * RXRAT( 110 ) ! CXO3+CXO3=2*ALD2+2*XO2+2*HO2 + & + RXRAT( 111 ) ! CXO3+C2O3=MEO2+XO2+HO2+ALD2 + + PROD( PANX ) = RXRAT( 103 ) ! CXO3+NO2=PANX + LOSS( PANX ) = RXRAT( 104 ) ! PANX=CXO3+NO2 + & + RXRAT( 105 ) ! PANX=CXO3+NO2 + & + RXRAT( 106 ) ! PANX+OH=ALD2+NO2 + + PROD( ROR ) = 0.760 * RXRAT( 112 ) ! PAR+OH=0.76*ROR+0.13*XO2N+... + & + 0.760 * RXRAT( 184 ) ! CL+PAR=0.76*ROR+0.87*XO2+... + LOSS( ROR ) = 0.980 * RXRAT( 113 ) ! ROR=0.02*ROR+0.6*ALD2+... + & + RXRAT( 114 ) ! ROR=HO2 + & + RXRAT( 115 ) ! ROR+NO2=NTR + + PROD( OLE ) = 0.300 * RXRAT( 188 ) ! CL+IOLE=0.3*OLE+0.7*FMCL+... + LOSS( OLE ) = RXRAT( 116 ) ! OLE+O=0.2*ALD2+0.3*ALDX+... + & + RXRAT( 117 ) ! OLE+OH=0.8*FORM+0.33*ALD2+... + & + RXRAT( 118 ) ! OLE+O3=0.18*ALD2+0.74*FORM+... + & + RXRAT( 119 ) ! OLE+NO3=NO2+FORM+0.91*XO2+... + & + RXRAT( 187 ) ! OLE+CL=FMCL+0.33*ALD2+... + + PROD( ETH ) = 0.0 + LOSS( ETH ) = RXRAT( 120 ) ! ETH+O=FORM+1.7*HO2+CO+... + & + RXRAT( 121 ) ! ETH+OH=XO2+1.56*FORM+... + & + RXRAT( 122 ) ! ETH+O3=FORM+0.63*CO+... + & + RXRAT( 123 ) ! ETH+NO3=NO2+XO2+2*FORM + & + RXRAT( 186 ) ! ETH+CL=FMCL+2*XO2+HO2+FORM + + PROD( IOLE ) = 0.0 + LOSS( IOLE ) = RXRAT( 124 ) ! IOLE+O=1.24*ALD2+0.66*ALDX+... + & + RXRAT( 125 ) ! IOLE+OH=1.3*ALD2+0.7*ALDX+... + & + RXRAT( 126 ) ! IOLE+O3=0.65*ALD2+... + & + RXRAT( 127 ) ! IOLE+NO3=1.18*ALD2+... + & + RXRAT( 188 ) ! IOLE+CL=0.3*HCL+0.7*FMCL+... + + PROD( TOL ) = 0.0 + LOSS( TOL ) = RXRAT( 128 ) ! TOL+OH=0.28*HO2+0.1*XO2+... + & + RXRAT( 196 ) ! TOL+CL=HCL+0.88*XO2+... + + PROD( CRES ) = 0.180 * RXRAT( 128 ) ! TOL+OH=0.18*CRES+0.1*XO2+... + & + RXRAT( 134 ) ! CRO+HO2=CRES + & + 0.200 * RXRAT( 154 ) ! OH+XYL=0.2*CRES+0.5*XO2+... + LOSS( CRES ) = RXRAT( 131 ) ! CRES+OH=0.06*CRO+0.12*XO2+... + & + RXRAT( 132 ) ! CRES+NO3=0.3*CRO+HNO3+... + + PROD( TO2 ) = 0.650 * RXRAT( 128 ) ! TOL+OH=0.65*TO2+0.1*XO2+... + & + 0.300 * RXRAT( 154 ) ! OH+XYL=0.3*TO2+0.5*XO2+... + LOSS( TO2 ) = RXRAT( 129 ) ! TO2+NO=0.86*NO2+1.2*HO2+... + & + RXRAT( 130 ) ! TO2+HO2= + + PROD( TOLRO2 ) = RXRAT( 128 ) ! TOL+OH=TOLRO2+0.1*XO2+... + LOSS( TOLRO2 ) = RXRAT( 198 ) ! TOLRO2+NO=NO+TOLNRXN + & + RXRAT( 199 ) ! TOLRO2+HO2=HO2+TOLHRXN + + PROD( OPEN ) = 0.860 * RXRAT( 129 ) ! TO2+NO=0.86*OPEN+1.2*HO2+... + & + 0.130 * RXRAT( 131 ) ! OH+CRES=0.13*OPEN+0.12*XO2+... + & + 0.120 * RXRAT( 132 ) ! CRES+NO3=0.12*OPEN+HNO3+... + LOSS( OPEN ) = RXRAT( 143 ) ! OPEN=OPO3+HO2+CO + & + RXRAT( 144 ) ! OPEN+OH=0.6*OPO3+0.4*CAO2 + & + RXRAT( 145 ) ! OPEN+O3=0.03*ALDX+... + & + RXRAT( 146 ) ! OPEN+NO3=OPO3+HNO3 + + PROD( MGLY ) = 0.520 * RXRAT( 129 ) ! TO2+NO=0.52*MGLY+1.2*HO2+... + & + 0.240 * RXRAT( 132 ) ! CRES+NO3=0.24*MGLY+HNO3+... + & + 0.200 * RXRAT( 145 ) ! OPEN+O3=0.2*MGLY+0.62*OPO3+... + & + 0.800 * RXRAT( 154 ) ! OH+XYL=0.8*MGLY+0.5*XO2+... + & + 0.168 * RXRAT( 161 ) ! OH+ISPD=0.168*MGLY+... + & + 0.850 * RXRAT( 162 ) ! O3+ISPD=0.85*MGLY+... + LOSS( MGLY ) = RXRAT( 155 ) ! MGLY+OH=XO2+C2O3 + & + RXRAT( 156 ) ! MGLY=C2O3+HO2+CO + + PROD( CRO ) = 0.060 * RXRAT( 131 ) ! OH+CRES=0.06*CRO+0.12*XO2+... + & + 0.300 * RXRAT( 132 ) ! CRES+NO3=0.3*CRO+HNO3+... + & + RXRAT( 148 ) ! CAT1+NO3=CRO+HNO3 + LOSS( CRO ) = RXRAT( 133 ) ! CRO+NO2=CRON + & + RXRAT( 134 ) ! CRO+HO2=CRES + + PROD( CAT1 ) = 0.732 * RXRAT( 131 ) ! OH+CRES=0.732*CAT1+... + LOSS( CAT1 ) = RXRAT( 147 ) ! CAT1+OH=CAO2 + & + RXRAT( 148 ) ! CAT1+NO3=CRO+HNO3 + + PROD( CRON ) = RXRAT( 133 ) ! CRO+NO2=CRON + LOSS( CRON ) = RXRAT( 135 ) ! CRON+OH=CRNO + & + RXRAT( 136 ) ! CRON+NO3=CRNO+HNO3 + + PROD( CRNO ) = RXRAT( 135 ) ! CRON+OH=CRNO + & + RXRAT( 136 ) ! CRON+NO3=CRNO+HNO3 + & + RXRAT( 139 ) ! CRN2+NO=CRNO+NO2 + & + RXRAT( 141 ) ! CRPX=CRNO+OH + LOSS( CRNO ) = RXRAT( 137 ) ! CRNO+NO2=2*NTR + & + RXRAT( 138 ) ! CRNO+O3=CRN2 + + PROD( CRN2 ) = RXRAT( 138 ) ! CRNO+O3=CRN2 + & + RXRAT( 142 ) ! CRPX+OH=CRN2 + LOSS( CRN2 ) = RXRAT( 139 ) ! CRN2+NO=CRNO+NO2 + & + RXRAT( 140 ) ! CRN2+HO2=CRPX + + PROD( CRPX ) = RXRAT( 140 ) ! CRN2+HO2=CRPX + LOSS( CRPX ) = RXRAT( 141 ) ! CRPX=CRNO+OH + & + RXRAT( 142 ) ! CRPX+OH=CRN2 + + PROD( OPO3 ) = RXRAT( 143 ) ! OPEN=OPO3+HO2+CO + & + 0.600 * RXRAT( 144 ) ! OPEN+OH=0.6*OPO3+0.4*CAO2 + & + 0.620 * RXRAT( 145 ) ! OPEN+O3=0.62*OPO3+... + & + RXRAT( 146 ) ! OPEN+NO3=OPO3+HNO3 + & + RXRAT( 153 ) ! OPAN=OPO3+NO2 + LOSS( OPO3 ) = RXRAT( 151 ) ! OPO3+NO=NO2+XO2+HO2+ALDX + & + RXRAT( 152 ) ! OPO3+NO2=OPAN + + PROD( CAO2 ) = 0.400 * RXRAT( 144 ) ! OPEN+OH=0.4*CAO2+0.6*OPO3 + & + RXRAT( 147 ) ! CAT1+OH=CAO2 + LOSS( CAO2 ) = RXRAT( 149 ) ! CAO2+NO=0.86*NO2+1.2*HO2+... + & + RXRAT( 150 ) ! CAO2+HO2= + + PROD( OPAN ) = RXRAT( 152 ) ! OPO3+NO2=OPAN + LOSS( OPAN ) = RXRAT( 153 ) ! OPAN=OPO3+NO2 + + PROD( XYL ) = 0.0 + LOSS( XYL ) = RXRAT( 154 ) ! XYL+OH=0.7*HO2+0.5*XO2+... + & + RXRAT( 197 ) ! XYL+CL=HCL+0.84*XO2+... + + PROD( XYLRO2 ) = RXRAT( 154 ) ! OH+XYL=XYLRO2+0.5*XO2+... + LOSS( XYLRO2 ) = RXRAT( 200 ) ! XYLRO2+NO=NO+XYLNRXN + & + RXRAT( 201 ) ! XYLRO2+HO2=HO2+XYLHRXN + + PROD( ISOP ) = 0.0 + LOSS( ISOP ) = RXRAT( 157 ) ! ISOP+O=0.75*ISPD+0.5*FORM+... + & + RXRAT( 158 ) ! ISOP+OH=0.912*ISPD+... + & + RXRAT( 159 ) ! ISOP+O3=0.65*ISPD+0.6*FORM+... + & + RXRAT( 160 ) ! ISOP+NO3=0.2*ISPD+0.8*NTR+... + & + RXRAT( 172 ) ! ISOP+NO2=0.2*ISPD+0.8*NTR+... + & + RXRAT( 189 ) ! ISOP+CL=0.15*HCL+XO2+HO2+... + + PROD( ISPD ) = 0.750 * RXRAT( 157 ) ! O+ISOP=0.75*ISPD+0.5*FORM+... + & + 0.912 * RXRAT( 158 ) ! OH+ISOP=0.912*ISPD+... + & + 0.650 * RXRAT( 159 ) ! O3+ISOP=0.65*ISPD+0.6*FORM+... + & + 0.200 * RXRAT( 160 ) ! NO3+ISOP=0.2*ISPD+0.8*NTR+... + & + 0.200 * RXRAT( 172 ) ! NO2+ISOP=0.2*ISPD+0.8*NTR+... + & + RXRAT( 189 ) ! CL+ISOP=ISPD+XO2+HO2+... + LOSS( ISPD ) = RXRAT( 161 ) ! ISPD+OH=1.565*PAR+... + & + RXRAT( 162 ) ! ISPD+O3=0.114*C2O3+... + & + RXRAT( 163 ) ! ISPD+NO3=0.357*ALDX+... + & + RXRAT( 164 ) ! ISPD=0.333*CO+0.067*ALD2+... + + PROD( ISOPRXN ) = RXRAT( 158 ) ! OH+ISOP=ISOPRXN+0.629*FORM+... + LOSS( ISOPRXN ) = 0.0 + + PROD( TERP ) = 0.0 + LOSS( TERP ) = RXRAT( 165 ) ! TERP+O=0.15*ALDX+5.12*PAR+... + & + RXRAT( 166 ) ! TERP+OH=0.75*HO2+1.25*XO2+... + & + RXRAT( 167 ) ! TERP+O3=0.57*OH+0.07*HO2+... + & + RXRAT( 168 ) ! TERP+NO3=0.47*NO2+0.28*HO2+... + + PROD( TRPRXN ) = RXRAT( 165 ) ! TERP+O=TRPRXN+5.12*PAR+... + & + RXRAT( 166 ) ! TERP+OH=TRPRXN+1.25*XO2+... + & + RXRAT( 167 ) ! TERP+O3=TRPRXN+0.07*HO2+... + & + RXRAT( 168 ) ! TERP+NO3=TRPRXN+0.28*HO2+... + LOSS( TRPRXN ) = 0.0 + + PROD( SO2 ) = 0.0 + LOSS( SO2 ) = RXRAT( 169 ) ! SO2+OH=SULF+HO2+SULRXN + + PROD( SULF ) = RXRAT( 169 ) ! SO2+OH=SULF+HO2+SULRXN + LOSS( SULF ) = 0.0 + + PROD( SULRXN ) = RXRAT( 169 ) ! SO2+OH=SULRXN+HO2+SULF + LOSS( SULRXN ) = 0.0 + + PROD( ETOH ) = 0.0 + LOSS( ETOH ) = RXRAT( 170 ) ! ETOH+OH=HO2+0.9*ALD2+... + & + RXRAT( 194 ) ! ETOH+CL=HCL+HO2+ALD2 + + PROD( ETHA ) = 0.0 + LOSS( ETHA ) = RXRAT( 171 ) ! ETHA+OH=0.991*ALD2+... + & + RXRAT( 185 ) ! ETHA+CL=HCL+0.991*ALD2+... + + PROD( RN ) = 0.0 + LOSS( RN ) = RXRAT( 173 ) ! RN= (radioactive decay) + + PROD( RN2 ) = 0.0 + LOSS( RN2 ) = RXRAT( 174 ) ! RN2=(radioactive decay) + + PROD( CL2 ) = 0.300 * RXRAT( 178 ) ! CLO+CLO=0.3*CL2+1.4*CL + LOSS( CL2 ) = RXRAT( 175 ) ! CL2=2*CL + + PROD( CL ) = 2.000 * RXRAT( 175 ) ! CL2=2*CL + & + RXRAT( 176 ) ! HOCL=CL+OH + & + 1.400 * RXRAT( 178 ) ! CLO+CLO=1.4*CL+0.3*CL2 + & + RXRAT( 179 ) ! CLO+NO=CL+NO2 + & + RXRAT( 181 ) ! OH+FMCL=CL+CO + & + RXRAT( 182 ) ! FMCL=CL+CO+HO2 + & + RXRAT( 195 ) ! HCL+OH=CL + LOSS( CL ) = RXRAT( 177 ) ! CL+O3=CLO + & + RXRAT( 183 ) ! CL=HCL+MEO2 + & + RXRAT( 184 ) ! CL+PAR=HCL+0.87*XO2+... + & + RXRAT( 185 ) ! CL+ETHA=HCL+0.991*ALD2+... + & + RXRAT( 186 ) ! CL+ETH=FMCL+2*XO2+HO2+FORM + & + RXRAT( 187 ) ! CL+OLE=FMCL+0.33*ALD2+... + & + RXRAT( 188 ) ! CL+IOLE=0.3*HCL+0.7*FMCL+... + & + RXRAT( 189 ) ! CL+ISOP=0.15*HCL+XO2+HO2+... + & + RXRAT( 190 ) ! CL+FORM=HCL+HO2+CO + & + RXRAT( 191 ) ! CL+ALD2=HCL+C2O3 + & + RXRAT( 192 ) ! CL+ALDX=HCL+CXO3 + & + RXRAT( 193 ) ! CL+MEOH=HCL+HO2+FORM + & + RXRAT( 194 ) ! CL+ETOH=HCL+HO2+ALD2 + & + RXRAT( 196 ) ! CL+TOL=HCL+0.88*XO2+... + & + RXRAT( 197 ) ! CL+XYL=HCL+0.84*XO2+... + + PROD( HOCL ) = RXRAT( 180 ) ! CLO+HO2=HOCL + LOSS( HOCL ) = RXRAT( 176 ) ! HOCL=OH+CL + + PROD( CLO ) = RXRAT( 177 ) ! CL+O3=CLO + LOSS( CLO ) = 2.000 * RXRAT( 178 ) ! CLO+CLO=0.3*CL2+1.4*CL + & + RXRAT( 179 ) ! CLO+NO=CL+NO2 + & + RXRAT( 180 ) ! CLO+HO2=HOCL + + PROD( FMCL ) = RXRAT( 186 ) ! CL+ETH=FMCL+2*XO2+HO2+FORM + & + RXRAT( 187 ) ! CL+OLE=FMCL+0.33*ALD2+... + & + 0.700 * RXRAT( 188 ) ! CL+IOLE=0.7*FMCL+0.3*HCL+... + & + 0.850 * RXRAT( 189 ) ! CL+ISOP=0.85*FMCL+XO2+HO2+... + LOSS( FMCL ) = RXRAT( 181 ) ! FMCL+OH=CL+CO + & + RXRAT( 182 ) ! FMCL=CL+CO+HO2 + + PROD( HCL ) = RXRAT( 183 ) ! CL=HCL+MEO2 + & + RXRAT( 184 ) ! CL+PAR=HCL+0.87*XO2+... + & + RXRAT( 185 ) ! CL+ETHA=HCL+0.991*ALD2+... + & + 0.300 * RXRAT( 188 ) ! CL+IOLE=0.3*HCL+0.7*FMCL+... + & + 0.150 * RXRAT( 189 ) ! CL+ISOP=0.15*HCL+XO2+HO2+... + & + RXRAT( 190 ) ! CL+FORM=HCL+HO2+CO + & + RXRAT( 191 ) ! CL+ALD2=HCL+C2O3 + & + RXRAT( 192 ) ! CL+ALDX=HCL+CXO3 + & + RXRAT( 193 ) ! CL+MEOH=HCL+HO2+FORM + & + RXRAT( 194 ) ! CL+ETOH=HCL+HO2+ALD2 + & + RXRAT( 196 ) ! CL+TOL=HCL+0.88*XO2+... + & + RXRAT( 197 ) ! CL+XYL=HCL+0.84*XO2+... + LOSS( HCL ) = RXRAT( 195 ) ! HCL+OH=CL + + PROD( TOLNRXN ) = RXRAT( 198 ) ! TOLRO2+NO=TOLNRXN+NO + LOSS( TOLNRXN ) = 0.0 + + PROD( TOLHRXN ) = RXRAT( 199 ) ! TOLRO2+HO2=TOLHRXN+HO2 + LOSS( TOLHRXN ) = 0.0 + + PROD( XYLNRXN ) = RXRAT( 200 ) ! XYLRO2+NO=XYLNRXN+NO + LOSS( XYLNRXN ) = 0.0 + + PROD( XYLHRXN ) = RXRAT( 201 ) ! XYLRO2+HO2=XYLHRXN+HO2 + LOSS( XYLHRXN ) = 0.0 + + PROD( BENZENE ) = 0.0 + LOSS( BENZENE ) = RXRAT( 202 ) ! BENZENE+OH=OH+BENZRO2 + + PROD( BENZRO2 ) = RXRAT( 202 ) ! BENZENE+OH=BENZRO2+OH + LOSS( BENZRO2 ) = RXRAT( 203 ) ! BENZRO2+NO=NO+BNZNRXN + & + RXRAT( 204 ) ! BENZRO2+HO2=HO2+BNZHRXN + + PROD( BNZNRXN ) = RXRAT( 203 ) ! BENZRO2+NO=BNZNRXN+NO + LOSS( BNZNRXN ) = 0.0 + + PROD( BNZHRXN ) = RXRAT( 204 ) ! BENZRO2+HO2=BNZHRXN+HO2 + LOSS( BNZHRXN ) = 0.0 + + PROD( SESQ ) = 0.0 + LOSS( SESQ ) = RXRAT( 205 ) ! SESQ+O3=O3+SESQRXN + & + RXRAT( 206 ) ! SESQ+OH=OH+SESQRXN + & + RXRAT( 207 ) ! SESQ+NO3=NO3+SESQRXN + + PROD( SESQRXN ) = RXRAT( 205 ) ! SESQ+O3=SESQRXN+O3 + & + RXRAT( 206 ) ! SESQ+OH=SESQRXN+OH + & + RXRAT( 207 ) ! SESQ+NO3=SESQRXN+NO3 + LOSS( SESQRXN ) = 0.0 + + PNEG( PAR ) = 0.660 * RXRAT( 61 ) ! NTR+OH=-0.66*PAR+HO2+... + & + 0.660 * RXRAT( 62 ) ! NTR=-0.66*PAR+HO2+... + & + 2.100 * RXRAT( 113 ) ! ROR=-2.1*PAR+0.6*ALD2+... + & + 0.700 * RXRAT( 117 ) ! OH+OLE=-0.7*PAR+0.33*ALD2+... + & + RXRAT( 118 ) ! O3+OLE=-PAR+0.74*FORM+... + & + RXRAT( 119 ) ! NO3+OLE=-PAR+FORM+0.91*XO2+... + & + RXRAT( 187 ) ! CL+OLE=-PAR+0.33*ALD2+... + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrrates.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrrates.F new file mode 100755 index 0000000..1b5dbb4 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrrates.F @@ -0,0 +1,274 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrrates.F,v 1.3 2011/10/21 16:10:54 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + + SUBROUTINE HRRATES + +C*********************************************************************** +C +C FUNCTION: To calculate rates of reactions +C +C PRECONDITIONS: For the CB05TUCL family of mechanisms +C +C KEY SUBROUTINES/FUNCTIONS CALLED: None +C +C REVISION HISTORY: Created by EBI solver program, Sept. 12, 2011 +C +C*********************************************************************** + USE HRDATA + + IMPLICIT NONE + +C.....INCLUDES: NONE + + +C.....ARGUMENTS: NONE + + +C.....PARAMETERS: NONE + + +C.....EXTERNAL FUNCTIONS: NONE + + +C.....SAVED VARIABLES: NONE + CHARACTER( 16 ), SAVE :: PNAME = 'HRRATES' ! Program name + + +C.....LOCAL VARIABLES: None + +C*********************************************************************** +C..NOTE: RXRAT commented out are not referenced by any routine +! RXRAT( 1 ) = RKI( 1 ) * YC( NO2 ) +! RXRAT( 2 ) = RKI( 2 ) * YC( O ) +! RXRAT( 3 ) = RKI( 3 ) * YC( O3 ) * YC( NO ) +! RXRAT( 4 ) = RKI( 4 ) * YC( O ) * YC( NO2 ) + RXRAT( 5 ) = RKI( 5 ) * YC( O ) * YC( NO2 ) +! RXRAT( 6 ) = RKI( 6 ) * YC( O ) * YC( NO ) + RXRAT( 7 ) = RKI( 7 ) * YC( NO2 ) * YC( O3 ) + RXRAT( 8 ) = RKI( 8 ) * YC( O3 ) + RXRAT( 9 ) = RKI( 9 ) * YC( O3 ) +! RXRAT( 10 ) = RKI( 10 ) * YC( O1D ) +! RXRAT( 11 ) = RKI( 11 ) * YC( O1D ) +! RXRAT( 12 ) = RKI( 12 ) * YC( O3 ) * YC( OH ) +! RXRAT( 13 ) = RKI( 13 ) * YC( O3 ) * YC( HO2 ) + RXRAT( 14 ) = RKI( 14 ) * YC( NO3 ) + RXRAT( 15 ) = RKI( 15 ) * YC( NO3 ) + RXRAT( 16 ) = RKI( 16 ) * YC( NO3 ) * YC( NO ) + RXRAT( 17 ) = RKI( 17 ) * YC( NO3 ) * YC( NO2 ) +! RXRAT( 18 ) = RKI( 18 ) * YC( NO3 ) * YC( NO2 ) + RXRAT( 19 ) = RKI( 19 ) * YC( N2O5 ) + RXRAT( 20 ) = RKI( 20 ) * YC( N2O5 ) + RXRAT( 21 ) = RKI( 21 ) * YC( N2O5 ) +! RXRAT( 22 ) = RKI( 22 ) * YC( NO ) * YC( NO ) + RXRAT( 23 ) = RKI( 23 ) * YC( NO ) * YC( NO2 ) +! RXRAT( 24 ) = RKI( 24 ) * YC( NO ) * YC( OH ) + RXRAT( 25 ) = RKI( 25 ) * YC( HONO ) + RXRAT( 26 ) = RKI( 26 ) * YC( OH ) * YC( HONO ) + RXRAT( 27 ) = RKI( 27 ) * YC( HONO ) * YC( HONO ) + RXRAT( 28 ) = RKI( 28 ) * YC( NO2 ) * YC( OH ) + RXRAT( 29 ) = RKI( 29 ) * YC( OH ) * YC( HNO3 ) +! RXRAT( 30 ) = RKI( 30 ) * YC( HO2 ) * YC( NO ) +! RXRAT( 31 ) = RKI( 31 ) * YC( HO2 ) * YC( NO2 ) + RXRAT( 32 ) = RKI( 32 ) * YC( PNA ) + RXRAT( 33 ) = RKI( 33 ) * YC( OH ) * YC( PNA ) + RXRAT( 34 ) = RKI( 34 ) * YC( HO2 ) * YC( HO2 ) + RXRAT( 35 ) = RKI( 35 ) * YC( HO2 ) * YC( HO2 ) + RXRAT( 36 ) = RKI( 36 ) * YC( H2O2 ) + RXRAT( 37 ) = RKI( 37 ) * YC( OH ) * YC( H2O2 ) +! RXRAT( 38 ) = RKI( 38 ) * YC( O1D ) +! RXRAT( 39 ) = RKI( 39 ) * YC( OH ) +! RXRAT( 40 ) = RKI( 40 ) * YC( OH ) * YC( O ) + RXRAT( 41 ) = RKI( 41 ) * YC( OH ) * YC( OH ) + RXRAT( 42 ) = RKI( 42 ) * YC( OH ) * YC( OH ) +! RXRAT( 43 ) = RKI( 43 ) * YC( OH ) * YC( HO2 ) +! RXRAT( 44 ) = RKI( 44 ) * YC( HO2 ) * YC( O ) + RXRAT( 45 ) = RKI( 45 ) * YC( H2O2 ) * YC( O ) + RXRAT( 46 ) = RKI( 46 ) * YC( NO3 ) * YC( O ) + RXRAT( 47 ) = RKI( 47 ) * YC( NO3 ) * YC( OH ) + RXRAT( 48 ) = RKI( 48 ) * YC( NO3 ) * YC( HO2 ) + RXRAT( 49 ) = RKI( 49 ) * YC( NO3 ) * YC( O3 ) + RXRAT( 50 ) = RKI( 50 ) * YC( NO3 ) * YC( NO3 ) + RXRAT( 51 ) = RKI( 51 ) * YC( PNA ) + RXRAT( 52 ) = RKI( 52 ) * YC( HNO3 ) + RXRAT( 53 ) = RKI( 53 ) * YC( N2O5 ) + RXRAT( 54 ) = RKI( 54 ) * YC( XO2 ) * YC( NO ) + RXRAT( 55 ) = RKI( 55 ) * YC( XO2N ) * YC( NO ) + RXRAT( 56 ) = RKI( 56 ) * YC( XO2 ) * YC( HO2 ) + RXRAT( 57 ) = RKI( 57 ) * YC( XO2N ) * YC( HO2 ) + RXRAT( 58 ) = RKI( 58 ) * YC( XO2 ) * YC( XO2 ) + RXRAT( 59 ) = RKI( 59 ) * YC( XO2N ) * YC( XO2N ) + RXRAT( 60 ) = RKI( 60 ) * YC( XO2 ) * YC( XO2N ) + RXRAT( 61 ) = RKI( 61 ) * YC( NTR ) * YC( OH ) + RXRAT( 62 ) = RKI( 62 ) * YC( NTR ) + RXRAT( 63 ) = RKI( 63 ) * YC( ROOH ) * YC( OH ) + RXRAT( 64 ) = RKI( 64 ) * YC( ROOH ) + RXRAT( 65 ) = RKI( 65 ) * YC( OH ) * YC( CO ) + RXRAT( 66 ) = RKI( 66 ) * YC( OH ) + RXRAT( 67 ) = RKI( 67 ) * YC( MEO2 ) * YC( NO ) + RXRAT( 68 ) = RKI( 68 ) * YC( MEO2 ) * YC( HO2 ) + RXRAT( 69 ) = RKI( 69 ) * YC( MEO2 ) * YC( MEO2 ) + RXRAT( 70 ) = RKI( 70 ) * YC( MEPX ) * YC( OH ) + RXRAT( 71 ) = RKI( 71 ) * YC( MEPX ) + RXRAT( 72 ) = RKI( 72 ) * YC( MEOH ) * YC( OH ) + RXRAT( 73 ) = RKI( 73 ) * YC( FORM ) * YC( OH ) + RXRAT( 74 ) = RKI( 74 ) * YC( FORM ) + RXRAT( 75 ) = RKI( 75 ) * YC( FORM ) + RXRAT( 76 ) = RKI( 76 ) * YC( FORM ) * YC( O ) + RXRAT( 77 ) = RKI( 77 ) * YC( FORM ) * YC( NO3 ) + RXRAT( 78 ) = RKI( 78 ) * YC( FORM ) * YC( HO2 ) + RXRAT( 79 ) = RKI( 79 ) * YC( HCO3 ) + RXRAT( 80 ) = RKI( 80 ) * YC( HCO3 ) * YC( NO ) + RXRAT( 81 ) = RKI( 81 ) * YC( HCO3 ) * YC( HO2 ) + RXRAT( 82 ) = RKI( 82 ) * YC( FACD ) * YC( OH ) + RXRAT( 83 ) = RKI( 83 ) * YC( ALD2 ) * YC( O ) + RXRAT( 84 ) = RKI( 84 ) * YC( ALD2 ) * YC( OH ) + RXRAT( 85 ) = RKI( 85 ) * YC( ALD2 ) * YC( NO3 ) + RXRAT( 86 ) = RKI( 86 ) * YC( ALD2 ) + RXRAT( 87 ) = RKI( 87 ) * YC( C2O3 ) * YC( NO ) +! RXRAT( 88 ) = RKI( 88 ) * YC( C2O3 ) * YC( NO2 ) + RXRAT( 89 ) = RKI( 89 ) * YC( PAN ) + RXRAT( 90 ) = RKI( 90 ) * YC( PAN ) + RXRAT( 91 ) = RKI( 91 ) * YC( C2O3 ) * YC( HO2 ) + RXRAT( 92 ) = RKI( 92 ) * YC( C2O3 ) * YC( MEO2 ) + RXRAT( 93 ) = RKI( 93 ) * YC( C2O3 ) * YC( XO2 ) + RXRAT( 94 ) = RKI( 94 ) * YC( C2O3 ) * YC( C2O3 ) + RXRAT( 95 ) = RKI( 95 ) * YC( PACD ) * YC( OH ) + RXRAT( 96 ) = RKI( 96 ) * YC( PACD ) + RXRAT( 97 ) = RKI( 97 ) * YC( AACD ) * YC( OH ) + RXRAT( 98 ) = RKI( 98 ) * YC( ALDX ) * YC( O ) + RXRAT( 99 ) = RKI( 99 ) * YC( ALDX ) * YC( OH ) + RXRAT( 100 ) = RKI( 100 ) * YC( ALDX ) * YC( NO3 ) + RXRAT( 101 ) = RKI( 101 ) * YC( ALDX ) + RXRAT( 102 ) = RKI( 102 ) * YC( CXO3 ) * YC( NO ) + RXRAT( 103 ) = RKI( 103 ) * YC( CXO3 ) * YC( NO2 ) + RXRAT( 104 ) = RKI( 104 ) * YC( PANX ) + RXRAT( 105 ) = RKI( 105 ) * YC( PANX ) + RXRAT( 106 ) = RKI( 106 ) * YC( PANX ) * YC( OH ) + RXRAT( 107 ) = RKI( 107 ) * YC( CXO3 ) * YC( HO2 ) + RXRAT( 108 ) = RKI( 108 ) * YC( CXO3 ) * YC( MEO2 ) + RXRAT( 109 ) = RKI( 109 ) * YC( CXO3 ) * YC( XO2 ) + RXRAT( 110 ) = RKI( 110 ) * YC( CXO3 ) * YC( CXO3 ) + RXRAT( 111 ) = RKI( 111 ) * YC( CXO3 ) * YC( C2O3 ) + RXRAT( 112 ) = RKI( 112 ) * YC( PAR ) * YC( OH ) + RXRAT( 113 ) = RKI( 113 ) * YC( ROR ) + RXRAT( 114 ) = RKI( 114 ) * YC( ROR ) + RXRAT( 115 ) = RKI( 115 ) * YC( ROR ) * YC( NO2 ) + RXRAT( 116 ) = RKI( 116 ) * YC( O ) * YC( OLE ) + RXRAT( 117 ) = RKI( 117 ) * YC( OH ) * YC( OLE ) + RXRAT( 118 ) = RKI( 118 ) * YC( O3 ) * YC( OLE ) + RXRAT( 119 ) = RKI( 119 ) * YC( NO3 ) * YC( OLE ) + RXRAT( 120 ) = RKI( 120 ) * YC( O ) * YC( ETH ) + RXRAT( 121 ) = RKI( 121 ) * YC( OH ) * YC( ETH ) + RXRAT( 122 ) = RKI( 122 ) * YC( O3 ) * YC( ETH ) + RXRAT( 123 ) = RKI( 123 ) * YC( NO3 ) * YC( ETH ) + RXRAT( 124 ) = RKI( 124 ) * YC( IOLE ) * YC( O ) + RXRAT( 125 ) = RKI( 125 ) * YC( IOLE ) * YC( OH ) + RXRAT( 126 ) = RKI( 126 ) * YC( IOLE ) * YC( O3 ) + RXRAT( 127 ) = RKI( 127 ) * YC( IOLE ) * YC( NO3 ) + RXRAT( 128 ) = RKI( 128 ) * YC( TOL ) * YC( OH ) + RXRAT( 129 ) = RKI( 129 ) * YC( TO2 ) * YC( NO ) + RXRAT( 130 ) = RKI( 130 ) * YC( TO2 ) * YC( HO2 ) + RXRAT( 131 ) = RKI( 131 ) * YC( OH ) * YC( CRES ) + RXRAT( 132 ) = RKI( 132 ) * YC( CRES ) * YC( NO3 ) + RXRAT( 133 ) = RKI( 133 ) * YC( CRO ) * YC( NO2 ) + RXRAT( 134 ) = RKI( 134 ) * YC( CRO ) * YC( HO2 ) + RXRAT( 135 ) = RKI( 135 ) * YC( CRON ) * YC( OH ) + RXRAT( 136 ) = RKI( 136 ) * YC( CRON ) * YC( NO3 ) + RXRAT( 137 ) = RKI( 137 ) * YC( CRNO ) * YC( NO2 ) + RXRAT( 138 ) = RKI( 138 ) * YC( CRNO ) * YC( O3 ) + RXRAT( 139 ) = RKI( 139 ) * YC( CRN2 ) * YC( NO ) + RXRAT( 140 ) = RKI( 140 ) * YC( CRN2 ) * YC( HO2 ) + RXRAT( 141 ) = RKI( 141 ) * YC( CRPX ) + RXRAT( 142 ) = RKI( 142 ) * YC( CRPX ) * YC( OH ) + RXRAT( 143 ) = RKI( 143 ) * YC( OPEN ) + RXRAT( 144 ) = RKI( 144 ) * YC( OPEN ) * YC( OH ) + RXRAT( 145 ) = RKI( 145 ) * YC( OPEN ) * YC( O3 ) + RXRAT( 146 ) = RKI( 146 ) * YC( OPEN ) * YC( NO3 ) + RXRAT( 147 ) = RKI( 147 ) * YC( CAT1 ) * YC( OH ) + RXRAT( 148 ) = RKI( 148 ) * YC( CAT1 ) * YC( NO3 ) + RXRAT( 149 ) = RKI( 149 ) * YC( CAO2 ) * YC( NO ) + RXRAT( 150 ) = RKI( 150 ) * YC( CAO2 ) * YC( HO2 ) + RXRAT( 151 ) = RKI( 151 ) * YC( OPO3 ) * YC( NO ) + RXRAT( 152 ) = RKI( 152 ) * YC( OPO3 ) * YC( NO2 ) + RXRAT( 153 ) = RKI( 153 ) * YC( OPAN ) + RXRAT( 154 ) = RKI( 154 ) * YC( OH ) * YC( XYL ) + RXRAT( 155 ) = RKI( 155 ) * YC( OH ) * YC( MGLY ) + RXRAT( 156 ) = RKI( 156 ) * YC( MGLY ) + RXRAT( 157 ) = RKI( 157 ) * YC( O ) * YC( ISOP ) + RXRAT( 158 ) = RKI( 158 ) * YC( OH ) * YC( ISOP ) + RXRAT( 159 ) = RKI( 159 ) * YC( O3 ) * YC( ISOP ) + RXRAT( 160 ) = RKI( 160 ) * YC( NO3 ) * YC( ISOP ) + RXRAT( 161 ) = RKI( 161 ) * YC( OH ) * YC( ISPD ) + RXRAT( 162 ) = RKI( 162 ) * YC( O3 ) * YC( ISPD ) + RXRAT( 163 ) = RKI( 163 ) * YC( NO3 ) * YC( ISPD ) + RXRAT( 164 ) = RKI( 164 ) * YC( ISPD ) + RXRAT( 165 ) = RKI( 165 ) * YC( TERP ) * YC( O ) + RXRAT( 166 ) = RKI( 166 ) * YC( TERP ) * YC( OH ) + RXRAT( 167 ) = RKI( 167 ) * YC( TERP ) * YC( O3 ) + RXRAT( 168 ) = RKI( 168 ) * YC( TERP ) * YC( NO3 ) + RXRAT( 169 ) = RKI( 169 ) * YC( SO2 ) * YC( OH ) + RXRAT( 170 ) = RKI( 170 ) * YC( OH ) * YC( ETOH ) + RXRAT( 171 ) = RKI( 171 ) * YC( OH ) * YC( ETHA ) + RXRAT( 172 ) = RKI( 172 ) * YC( NO2 ) * YC( ISOP ) + RXRAT( 173 ) = RKI( 173 ) * YC( RN ) + RXRAT( 174 ) = RKI( 174 ) * YC( RN2 ) + RXRAT( 175 ) = RKI( 175 ) * YC( CL2 ) + RXRAT( 176 ) = RKI( 176 ) * YC( HOCL ) + RXRAT( 177 ) = RKI( 177 ) * YC( CL ) * YC( O3 ) + RXRAT( 178 ) = RKI( 178 ) * YC( CLO ) * YC( CLO ) + RXRAT( 179 ) = RKI( 179 ) * YC( CLO ) * YC( NO ) + RXRAT( 180 ) = RKI( 180 ) * YC( CLO ) * YC( HO2 ) + RXRAT( 181 ) = RKI( 181 ) * YC( OH ) * YC( FMCL ) + RXRAT( 182 ) = RKI( 182 ) * YC( FMCL ) + RXRAT( 183 ) = RKI( 183 ) * YC( CL ) + RXRAT( 184 ) = RKI( 184 ) * YC( CL ) * YC( PAR ) + RXRAT( 185 ) = RKI( 185 ) * YC( CL ) * YC( ETHA ) + RXRAT( 186 ) = RKI( 186 ) * YC( CL ) * YC( ETH ) + RXRAT( 187 ) = RKI( 187 ) * YC( CL ) * YC( OLE ) + RXRAT( 188 ) = RKI( 188 ) * YC( CL ) * YC( IOLE ) + RXRAT( 189 ) = RKI( 189 ) * YC( CL ) * YC( ISOP ) + RXRAT( 190 ) = RKI( 190 ) * YC( CL ) * YC( FORM ) + RXRAT( 191 ) = RKI( 191 ) * YC( CL ) * YC( ALD2 ) + RXRAT( 192 ) = RKI( 192 ) * YC( CL ) * YC( ALDX ) + RXRAT( 193 ) = RKI( 193 ) * YC( CL ) * YC( MEOH ) + RXRAT( 194 ) = RKI( 194 ) * YC( CL ) * YC( ETOH ) + RXRAT( 195 ) = RKI( 195 ) * YC( HCL ) * YC( OH ) + RXRAT( 196 ) = RKI( 196 ) * YC( CL ) * YC( TOL ) + RXRAT( 197 ) = RKI( 197 ) * YC( CL ) * YC( XYL ) + RXRAT( 198 ) = RKI( 198 ) * YC( TOLRO2 ) * YC( NO ) + RXRAT( 199 ) = RKI( 199 ) * YC( TOLRO2 ) * YC( HO2 ) + RXRAT( 200 ) = RKI( 200 ) * YC( XYLRO2 ) * YC( NO ) + RXRAT( 201 ) = RKI( 201 ) * YC( XYLRO2 ) * YC( HO2 ) + RXRAT( 202 ) = RKI( 202 ) * YC( BENZENE ) * YC( OH ) + RXRAT( 203 ) = RKI( 203 ) * YC( BENZRO2 ) * YC( NO ) + RXRAT( 204 ) = RKI( 204 ) * YC( BENZRO2 ) * YC( HO2 ) + RXRAT( 205 ) = RKI( 205 ) * YC( SESQ ) * YC( O3 ) + RXRAT( 206 ) = RKI( 206 ) * YC( SESQ ) * YC( OH ) + RXRAT( 207 ) = RKI( 207 ) * YC( SESQ ) * YC( NO3 ) + + + RETURN + + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/hrsolver.F b/models/CCTM/gas/ebi_cb05tucl_RN2/hrsolver.F new file mode 100755 index 0000000..fccc90f --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/hrsolver.F @@ -0,0 +1,347 @@ + +!------------------------------------------------------------------------! +! 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/yoj/arc/CCTM/src/gas/ebi_cb05tucl/hrsolver.F,v 1.4 2011/10/21 16:10:54 yoj Exp $ + +C what(1) key, module and SID; SCCS file; date and time of last delta: +C %W% %P% %G% %U% + +C::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + SUBROUTINE HRSOLVER( JDATE, JTIME, C, R, L ) + +C----------------------------------------------------------------------- +C Function: EBI solver +C +C Preconditions: For the CB05TUCL family of mechanisms +C +C Key Subroutines/Functions Called: HRRATES, HRG1, HRG2, HRG3, +C HRG4, HRPRODLOSS +C +C Revision History: Created by EBI solver program, Jan. 21, 2011 +C Revised hrsolver.F by Golam Sarwar, December, 2007 +C rearranged a statement suggested by CARB +C to reduce the chance of code crash; it does +C not change results +C 21 Jun 10 J.Young: convert for Namelist redesign +C 29 Mar 11 S.Roselle: Replaced I/O API include files with UTILIO_DEFN +C----------------------------------------------------------------------- + + USE CGRID_SPCS, ONLY: N_GC_SPC, GC_SPC ! CGRID mechanism species + USE UTILIO_DEFN + USE HRDATA + + IMPLICIT NONE + +C..Includes: + +C..Arguments: + INTEGER JDATE ! Current date (YYYYDDD) + INTEGER JTIME ! Current time (HHMMSS) + INTEGER C, R, L ! Cell col, row, lev + +C..Parameters: + INTEGER, PARAMETER :: MXBKUPS = 5 ! Max no. of back-ups allowed + INTEGER, PARAMETER :: STAT = 1 ! Status code + + REAL, PARAMETER :: EPSLON = 1.0E-30 ! Small number + REAL, PARAMETER :: MAXPRED = 1.0E+03 ! Upper limit on predicted conc + REAL, PARAMETER :: ZERO = 0.0 ! zero + +C..External Functions: + +C..Saved Local Variables: + CHARACTER( 16 ), SAVE :: PNAME = 'HRSOLVER' ! Program name + LOGICAL, ALLOCATABLE, SAVE :: LEBISPFL( : ) ! Flag for EBI species + LOGICAL, SAVE :: LFIRST = .TRUE. ! Flag for first call + +C..Scratch Local Variables: + + CHARACTER( 132 ) :: MSG ! Message text + + INTEGER CELLNO ! Cell no. fo debug output + INTEGER ITER ! Loop index for Backward Euler iterations + INTEGER S ! Loop index for species + INTEGER NEBI ! Loop index for time steps + INTEGER NINR ! No. of inner time steps + INTEGER N ! Loop index + INTEGER EBI ! Loop index + INTEGER NBKUPS ! No. of times time step reduced + INTEGER ERR ! Allocate error flag + + LOGICAL LEBI_CONV ! Flag for EBI convergence + LOGICAL MXFL ! hit MAXPRED flag + + REAL DTC ! Time step to take + REAL FXDLOSS ! Total loss due to negative stoichiometry + REAL VARLOSS ! Loss excluding negative stoichiometry + + +#ifdef hrdebug + CHARACTER( 8 ) :: NOTE ! Convergence fail note + + INTEGER COL ! Column to generate deboug output for + INTEGER ROW ! Row to generate deboug output for + INTEGER LEV ! Level to generate deboug output for + INTEGER DBGOUT ! Output unit for debu outpt + + LOGICAL LDEBUG ! Debug output flag + LOGICAL, SAVE :: LOPEN = .FALSE. +#endif + +C----------------------------------------------------------------------- + + IF ( LFIRST ) THEN + LFIRST = .FALSE. + LOGDEV = INIT3( ) + + ALLOCATE ( LEBISPFL( N_GC_SPC ), STAT = ERR ) + IF ( ERR .NE. 0 ) THEN + MSG = 'Error allocating LEBISPFL' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + END IF + END IF + +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ +#ifdef hrdebug + COL = 0 + ROW = 0 + LEV = 0 + IF ( C .EQ. COL .AND. R .EQ. ROW .AND. L .EQ. LEV ) THEN +c IF ( JTIME .EQ. 160000 ) THEN + LDEBUG = .TRUE. + ELSE + LDEBUG = .FALSE. + END IF + + IF ( LDEBUG ) THEN + IF ( .NOT. LOPEN ) THEN + DBGOUT = JUNIT() + OPEN( UNIT = DBGOUT, FILE = 'debug.out' ) + LOPEN = .TRUE. + END IF + + WRITE( DBGOUT, '( A, 2I4, I3, 1X, I7, 1X, I6 ) ' ) + & 'Debug output for col/row/lev/date/time:', + & C, R, L, JDATE, JTIME + WRITE( DBGOUT, '( A, F7.2) ' ) + & 'EBI_TMSTEP = ', EBI_TMSTEP + WRITE( DBGOUT, '( A )' ) 'Starting concs and rate constants' + DO N = 1, N_SPEC + WRITE( DBGOUT, '( A, I3, 1X, A, 1X, 1PE13.5 )' ) + & 'SP ',N, GC_SPC( N ), YC( N ) + END DO + DO N = 1, N_RXNS + WRITE( DBGOUT, '( A, I3, 1X, 1PE13.5 )' ) + & 'RKI ', N, RKI( N ) + END DO + END IF +#endif +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ + + N_EBI_IT = 0 + + DO 3000 NEBI = 1, N_EBI_STEPS ! outer EBI time-tep loop + + DTC = EBI_TMSTEP + NBKUPS = 0 + N_INR_STEPS = 1 + + 100 CONTINUE ! Restart location + + DO 2000 NINR = 1, N_INR_STEPS ! No. of time steps for back-up + + DO S = 1, N_SPEC ! Set ICs for EBI iterations + YC0( S ) = YC( S ) + END DO + + DO 1000 ITER = 1, NEBITER ! EBI iteration loop + + N_EBI_IT = N_EBI_IT + 1 + + CALL HRRATES + +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ +#ifdef hrdebug + IF ( LDEBUG ) THEN + WRITE( DBGOUT, '( A, I5 )' ) 'ITER NO ', ITER + WRITE( DBGOUT, '( A, F12.5 )' ) + & ' DTC=', DTC + + IF ( ITER .EQ. 1 ) THEN + WRITE( DBGOUT, '( A )' ) 'Starting reaction rates' + DO N = 1, N_RXNS + WRITE( DBGOUT, '( A, I3, 1X, 1PE13.5 )' ) + & 'RXRAT ', N, RXRAT( N ) + END DO + END IF + END IF +#endif +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Call routines to compute concentrations of groups 1-4 +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + CALL HRG1( DTC ) + + CALL HRG2( DTC ) + + CALL HRG3( DTC ) + + CALL HRG4( DTC ) + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Do the Euler backward method +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + CALL HRPRODLOSS + + DO EBI = 1, N_EBISP + S = EBISP( EBI ) + YCP( S ) = YC( S ) * ( ( YC0( S ) + PROD( S ) * DTC ) / + & ( YC ( S ) + LOSS( S ) * DTC ) ) + END DO + +c..Special treatment of PAR because of negative product stoichiometry + IF ( PNEG( PAR ) .GT. 0.0 ) THEN + FXDLOSS = PNEG( PAR ) * DTC + IF ( FXDLOSS .GE. YC0( PAR ) + PROD( PAR ) * DTC ) THEN + YCP( PAR ) = 0.0 + ELSE + VARLOSS = MAX( LOSS( PAR ) - PNEG( PAR ) , ZERO ) + YCP( PAR ) = ( YC0( PAR ) + PROD( PAR ) * DTC - + & FXDLOSS ) / ( 1.0 + VARLOSS * DTC / YC( PAR ) ) + END IF + END IF + +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +c Check for convergence +cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + LEBI_CONV = .TRUE. + MXFL = .FALSE. + DO S = 1, N_SPEC + LEBISPFL( S ) = .FALSE. + YCP( S ) = MAX( EPSLON, YCP( S ) ) + IF ( ABS( YC( S ) - YCP( S ) ) .GT. RTOL( S ) * + & ( YC( S ) + YCP( S ) ) ) THEN + LEBI_CONV = .FALSE. + LEBISPFL( S ) = .TRUE. + END IF +c..if predictions growing too large, treat as a convergence failure + IF ( YCP( S ) .GT. MAXPRED ) then + MXFL = .TRUE. + GO TO 1010 + END IF + YC( S ) = YCP( S ) + END DO + +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ +#ifdef hrdebug + IF ( LDEBUG ) THEN + WRITE( DBGOUT, '( A, I5 )' ) 'Concs after ITER= ', ITER + DO S = 1, N_SPEC + + IF ( LEBISPFL( S ) ) THEN + NOTE = 'CONV FAIL' + ELSE + NOTE = ' ' + END IF + + WRITE( DBGOUT, '( I3, 1X, A, 1PE13.5, 1X, A )' ) + & S, GC_SPC( S ), YC( S ), NOTE + END DO + IF ( LEBI_CONV ) WRITE( DBGOUT, '( A )' ) + & '****Convergence achieved' + END IF +#endif +c++++++++++++++++++++++++Debug section++++++++++++++++++++++++++++++++++ + + + IF ( LEBI_CONV ) GO TO 2000 + +1000 CONTINUE + +c...Convergence failure section; cut the inner time step in half & +c.....start inner loop over unless max backups exceeded + +1010 CONTINUE + + NBKUPS = NBKUPS + 1 + + IF ( NBKUPS .LE. MXBKUPS ) THEN + + IF ( MXFL ) THEN + WRITE( LOGDEV, 92010 ) C, R, L, TRIM( GC_SPC( S ) ), NBKUPS + ELSE + WRITE( LOGDEV, 92000 ) C, R, L, NBKUPS + END IF + + DO S = 1, N_SPEC + YC( S ) = YC0( s ) + END DO + + DTC = 0.5 * DTC + + N_INR_STEPS = 2 ** NBKUPS + + GO TO 100 + + ELSE + + WRITE( LOGDEV, 92040 ) C, R, L + + WRITE( LOGDEV, 92060 ) + DO S = 1, N_SPEC + IF ( LEBISPFL( S ) ) WRITE( LOGDEV, 92080 ) GC_SPC( S ) + END DO + + MSG = 'ERROR: Stopping because of EBI convergence failures' + CALL M3EXIT( PNAME, JDATE, JTIME, MSG, XSTAT1 ) + + END IF + +2000 CONTINUE + +3000 CONTINUE + + RETURN + +92000 FORMAT( 'WARNING: EBI Euler convergence failure' / + & ' Reducing EBI time step because of ', + & 'convergence failure for ' / + & ' Cell (', I3, ', ', I3, ', ', I3, ')' , + & ' Back-up number', I2 ) + +92010 FORMAT( 'WARNING: EBI Euler convergence failure' / + & ' Reducing EBI time step because of ', + & 'MAXPRED convergence failure for ' / + & ' Cell (', I3, ', ', I3, ', ', I3, ')' , + & ' and species ', A, + & ' Back-up number', I2 ) + +92040 FORMAT( 'ERROR: Max number of EBI time step reductions exceeded' + & / ' Convergence failure for cell (', I3, ', ', I3, + & ', ', I3, ')' ) + +92060 FORMAT( ' Convergence failure for the following species:' ) + +92080 FORMAT( 10X, A ) + + END diff --git a/models/CCTM/gas/ebi_cb05tucl_RN2/update_spec_nums.sh b/models/CCTM/gas/ebi_cb05tucl_RN2/update_spec_nums.sh new file mode 100755 index 0000000..5f779c2 --- /dev/null +++ b/models/CCTM/gas/ebi_cb05tucl_RN2/update_spec_nums.sh @@ -0,0 +1,33 @@ +#!/bin/bash + +for i1 in `seq 206 -1 174` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrprodloss.F" +done + +for i1 in `seq 206 -1 174` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrrates.F" +done + + +for i1 in `seq 206 -1 174` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrg1.F" +done + +for i1 in `seq 206 -1 174` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrg2.F" +done + +for i1 in `seq 206 -1 174` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrg3.F" +done + +for i1 in `seq 206 -1 174` ; do + i2=`echo $i1+1|bc` + bash -c "perl -pi -e 's/ $i1 / $i2 /g' hrg4.F" +done + diff --git a/models/CCTM/util/util/get_envlist.f b/models/CCTM/util/util/get_envlist.f index 4bcd4c1..c4c413a 100644 --- a/models/CCTM/util/util/get_envlist.f +++ b/models/CCTM/util/util/get_envlist.f @@ -51,7 +51,7 @@ SUBROUTINE GET_ENVLIST ( ENV_VAR, NVARS, VAL_LIST ) INTEGER, INTENT ( OUT ) :: NVARS CHARACTER( 16 ), INTENT ( OUT ) :: VAL_LIST( : ) - INTEGER, PARAMETER :: MAX_LEN = 512 + INTEGER, PARAMETER :: MAX_LEN = 2048 CHARACTER( 16 ) :: PNAME = 'GET_ENVLIST' CHARACTER( MAX_LEN ) :: E_VAL CHARACTER( 1 ) :: CHR diff --git a/models/ICON/prof_data/CH4only/ic_profile_CH4only.dat b/models/ICON/prof_data/CH4only/ic_profile_CH4only.dat new file mode 100755 index 0000000..69a4008 --- /dev/null +++ b/models/ICON/prof_data/CH4only/ic_profile_CH4only.dat @@ -0,0 +1,6 @@ + CH4only gas mechanism with AERO5 species and toxics + icon profile data converted from RADM2 gas mechanism species + number of layers, number of species, terrain-following sigma levels: + 6 1 1.00 0.98 0.93 0.84 0.60 0.30 0.00 + 2011-08-10 +"CH4 " 1.8 1.8 1.8 1.8 1.8 1.8 diff --git a/scripts/bcon/bldit.bcon b/scripts/bcon/bldit.bcon index e82b0a8..5de3d20 100755 --- a/scripts/bcon/bldit.bcon +++ b/scripts/bcon/bldit.bcon @@ -50,9 +50,9 @@ #> user choices: base working directory set Base = $cwd - set APPL = D502a + #set APPL = D502a_cb05tucl_ae6_aq + set APPL = CH4only set CFG = cfg.$APPL - set MODEL = BCON_${APPL}_$EXEC_ID #set Local # do NOT copy the source files into the BLD directory - # comment out to copy the source files (default if not set) @@ -79,18 +79,33 @@ set ModCommon = common #> If this is a nested simulation, use the m3conc option to extract BCs from a CCTM CONC file - set ModType = profile -#set ModType = m3conc +# set ModType = profile +# set ModType = m3conc #set ModType = tracer - set ModMech = prof_data/cb05_ae6_aq + if ( $?MODTYPE ) then + set ModType = $MODTYPE + else + echo "MODTYPE environment variable not set" + exit 1 + endif + +# set ModMech = prof_data/cb05tucl_ae6_aq_RN2 +# set ModMech = prof_data/CO2only + set ModMech = prof_data/CH4only +# set ModMech = prof_data/cb05tucl_ae6_aq_CO2 +# set ModMech = prof_data/cb05tucl_ae6_aq #set ModMech = prof_data/saprc99_ae6_aq #set ModMech = prof_data/saprc07t_ae6_aq #> user choices: mechanism #set Mechanism = cb05cl_ae5_aq #set Mechanism = cb05tucl_ae5_aq - set Mechanism = cb05tucl_ae6_aq +# set Mechanism = cb05tucl_ae6_aq_RN2 +# set Mechanism = CO2only + set Mechanism = CH4only +# set Mechanism = cb05tucl_ae6_aq_CO2 +# set Mechanism = cb05tucl_ae6_aq #set Mechanism = cb05tump_ae6_aq #set Mechanism = saprc99_ae5_aq #set Mechanism = saprc99_ae6_aq @@ -104,6 +119,8 @@ #> library paths set Bld = $Base/BLD_${APPL} + + set MODEL = BCON_${APPL}_${EXEC_ID}_${ModType}_${Mechanism} #> Set full path of Fortran 90 compiler set FC = ${myFC} @@ -113,19 +130,20 @@ set Blder = $M3LIB/bldmake #> Set location of libraries/include files - set IOAPI = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lioapi" - set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext}" + set IOAPI = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID} -lioapi" + set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID}" # set NETCDF = "${M3LIB}/netcdf/lib -lnetcdf" # set NETCDF = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lnetcdf" - set NETCDF = "/home/563/jds563/.local/lib -lnetcdf -lnetcdff" + #set NETCDF = "/apps/netcdf/4.7.1/lib -lnetcdf -L/apps/netcdf/4.7.1/lib/Intel -lnetcdff" + set NETCDF = "`nf-config --flibs`" #> Set compiler flags set F_FLAGS = "${myFFLAGS} -I ${IOAPIMOD} -I." set F90_FLAGS = "${myFRFLAGS} -I ${IOAPIMOD} -I." set CPP_FLAGS = "" set C_FLAGS = "${myCFLAGS} -DFLDMN" - set LINK_FLAGS = "${myLINK_FLAG} -lpthread -openmp" + set LINK_FLAGS = "${myLINK_FLAG} -lpthread -fopenmp" #:#:#:#:#:#:#:#:#:#:#:# End of User Input Section :#:#:#:#:#:#:#:#:#:#:#:#:# @@ -146,7 +164,7 @@ set Str2 = set LIB1 = "-L${IOAPI}" - set LIB2 = "-L${NETCDF}" + set LIB2 = "${NETCDF}" set LIBS = "$LIB1 $LIB2 ${extra_lib}" source $Base/relinc.bcon @@ -222,15 +240,19 @@ unalias mv rm if ( $?MakeFileOnly ) then if ( $?Local ) then + echo $Blder -makefo -git_local $Cfile # $Cfile = ${CFG}.bld $Blder -makefo -git_local $Cfile # $Cfile = ${CFG}.bld else + echo $Blder -makefo $Cfile $Blder -makefo $Cfile # totalview -a $Blder -makefo $Cfile endif else # also compile the model if ( $?Local ) then + echo $Blder -git_local $Cfile $Blder -git_local $Cfile else + echo $Blder $Cfile $Blder $Cfile endif endif diff --git a/scripts/build/bldit.bldmake b/scripts/build/bldit.bldmake index f2811cb..294dbd6 100755 --- a/scripts/build/bldit.bldmake +++ b/scripts/build/bldit.bldmake @@ -39,8 +39,6 @@ set DEST = $M3LIB - set echo - #:#:#:#:#:#:#:#:#:#:#:# Begin User Input Section #:#:#:#:#:#:#:#:#:#:#:# #> user choices: Git repository diff --git a/scripts/cctm/bldit.cctm b/scripts/cctm/bldit.cctm index 778a78c..3ea642e 100755 --- a/scripts/cctm/bldit.cctm +++ b/scripts/cctm/bldit.cctm @@ -50,7 +50,10 @@ #> user choices: base working directory, application string set Base = $cwd - set APPL = D502a + #set APPL = D502a_cb05tucl_ae6_aq + #set APPL = D502a_RN + #set APPL = D502a_CO2 + set APPL = CH4only set MODEL = CCTM_${APPL}_$EXEC_ID set CFG = cfg.$MODEL @@ -114,8 +117,9 @@ set ParOpt # set for multiple PE's; comment out for single PE set ModVdiff = vdiff/acm2 #set ModVdiff = vdiff/acm2_mp - set ModDepv = depv/m3dry +# set ModDepv = depv/m3dry #set ModDepv = depv/m3dry_mp +set ModDepv = depv/blank set ModEmis = emis/emis @@ -124,26 +128,31 @@ set ModEmis = emis/emis set ModPlmrs = plrise/smoke set ModCgrds = spcs/cgrid_spcs_nml -#set ModCgrds = spcs/cgrid_spcs_icl +# set ModCgrds = spcs/cgrid_spcs_icl set ModPhot = phot/phot_inline #set ModPhot = phot/phot_table #set ModGas = gas/smvgear #set ModGas = gas/ros3 -#set ModGas = gas/ebi_cb05cl -set ModGas = gas/ebi_cb05tucl +# set ModGas = gas/CH4only +# set ModGas = gas/ebi_cb05tucl +#set ModGas = gas/ebi_cb05tucl_RN2 +set ModGas = gas/blank #set ModGas = gas/ebi_cb05tump #set ModGas = gas/ebi_saprc99 #set ModGas = gas/ebi_saprc07tb #set ModGas = gas/ebi_saprc07tc -#set ModAero = aero/aero5 - set ModAero = aero/aero6 +# set ModAero = aero/aero5 +# set ModAero = aero/aero6 +# set ModAero = aero/blank + set ModAero = aero/aero_noop #set ModAero = aero/aero6_mp #set ModCloud = cloud/cloud_acm_ae5 -set ModCloud = cloud/cloud_acm_ae6 +#set ModCloud = cloud/cloud_acm_ae6 + set ModCloud = cloud/blank #set ModCloud = cloud/cloud_acm_ae6_mp set ModPa = procan/pa @@ -152,8 +161,11 @@ set ModCloud = cloud/cloud_acm_ae6 #> user choices: mechanism #set Mechanism = cb05cl_ae5_aq -#set Mechanism = cb05tucl_ae5_aq -set Mechanism = cb05tucl_ae6_aq +# set Mechanism = cb05tucl_ae6_aq +# set Mechanism = cb05tucl_ae6_aq_RN2 +#set Mechanism = CO2only + set Mechanism = CH4only +#set Mechanism = racm2_ae6_aq #set Mechanism = trac1 #set Mechanism = cb05tump_ae6_aq #set Mechanism = saprc99_ae5_aq @@ -179,13 +191,14 @@ set Mechanism = cb05tucl_ae6_aq set Blder = $M3LIB/bldmake #> Set location of libraries/include files - set LIOAPI = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lioapi" - set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext}" + set LIOAPI = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID} -lioapi" + set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID}" echo LIOAPI $LIOAPI echo IOAPIMOD $IOAPIMOD # set NETCDF = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lnetcdf" - set NETCDF = "/home/563/jds563/.local/lib -lnetcdf -lnetcdff" +# set NETCDF = "${NETCDF_BASE}/lib -lnetcdf -L${NETCDF_BASE}/lib/Intel -lnetcdff" + set NETCDF = "`nf-config --flibs`" if ( $?ParOpt ) then # Multiprocessor system configuration set PARIO = ${M3LIB}/pario @@ -201,7 +214,7 @@ echo IOAPIMOD $IOAPIMOD set F90_FLAGS = "${myFRFLAGS} -I ${IOAPIMOD} -I ${PARIO} -I ${STENEX} -I ${MPI_INC} -I." set CPP_FLAGS = "" set C_FLAGS = "${myCFLAGS} -DFLDMN -I ${MPI_INC}" - set LINK_FLAGS = "${myLINK_FLAG} -lpthread -openmp" + set LINK_FLAGS = "${myLINK_FLAG} -fopenmp" #:#:#:#:#:#:#:#:#:#:#:# End of User Input Section :#:#:#:#:#:#:#:#:#:#:#:#:# @@ -210,6 +223,7 @@ echo IOAPIMOD $IOAPIMOD set LIB2 = "-L${M3LIB}/pario -lpario" set LIB3 = set LIB4 = "-L${M3HOME}/lib/mpich/lib ${mpi} ${extra_lib}" + set LIB4 = set Str1 = (// Parallel / Include message passing definitions) set Str2 = (include SUBST_MPI ${MPI_INC}/mpif.h;) else @@ -223,8 +237,8 @@ echo IOAPIMOD $IOAPIMOD set LIB1 = "-L${STENEX} -l${seL}" set LIB5 = "-L${LIOAPI}" - set LIB6 = "-L${NETCDF}" - set LIB7 = "-L/home/563/jds563/programs/pvm3/lib/LINUX64 -lpvm3 -lfpvm3" + set LIB6 = "${NETCDF}" + set LIB7 = "" set LIBS = "$LIB1 $LIB2 $LIB3 $LIB4 $LIB5 $LIB6 $LIB7" @@ -424,17 +438,20 @@ echo IOAPIMOD $IOAPIMOD echo "Module ${ModPhot};" >> $Cfile echo >> $Cfile - set text = "smvgear, ros3, ebi_cb05cl, ebi_cb05tucl, ebi_cb05tump, ebi_saprc99, ebi_saprc07tb, and ebi_saprc07tc" + #set text = "smvgear, ros3, ebi_cb05cl, ebi_cb05tucl, ebi_cb05tump, ebi_saprc99, ebi_saprc07tb, and ebi_saprc07tc" + set text = "blank" echo "// options are" $text >> $Cfile echo "Module ${ModGas};" >> $Cfile echo >> $Cfile - set text = "aero5, aero6, and aero6_mp" + #set text = "aero5, aero6, and aero6_mp" + set text = "blank" echo "// options are" $text >> $Cfile echo "Module ${ModAero};" >> $Cfile echo >> $Cfile - set text = "cloud_acm_ae5, cloud_acm_ae6, and cloud_acm_ae6_mp" + #set text = "cloud_acm_ae5, cloud_acm_ae6, and cloud_acm_ae6_mp" + set text = "blank" echo "// options are" $text >> $Cfile echo "Module ${ModCloud};" >> $Cfile echo >> $Cfile diff --git a/scripts/config.cmaq b/scripts/config.cmaq index 4120c55..10da90a 100755 --- a/scripts/config.cmaq +++ b/scripts/config.cmaq @@ -1,4 +1,4 @@ -#!/bin/csh -f +#! /bin/csh -f # ================= CMAQ5.0.2 Configuration Script ================== # # Requirements: I/O API & netCDF libs, PGI, Intel, Gnu Compiler # @@ -13,24 +13,24 @@ #> sourced from bldit. #> model repository location - setenv M3HOME /home/563/jds563/programs/CMAQ/CMAQv5.0.2_notpollen + setenv M3HOME /opt/cmaq/CMAQv5.0.2_notpollen setenv M3MODEL ${M3HOME}/models - setenv M3DATA /short/w22/jds563/data/CMAQ-benchmark/CMAQv5.0.2/data - + setenv M3DATA ${M3HOME}/data #=============================================================================== #> architecture & compiler specific settings #------------------------------------------------------------------------------- #> set the COMPILER - setenv COMPILER intel +# setenv COMPILER intel # setenv COMPILER pgi -# setenv COMPILER gcc +setenv COMPILER gcc - setenv system "`/bin/uname -i`" + setenv system "`/bin/uname -m`" setenv bld_os "`/bin/uname -s``/bin/uname -r | cut -d. -f1`" setenv lib_basedir $M3HOME/lib -######## set these extra library paths only if needed for your architecture + +######## set these extra library paths only if needed for your architecture #setenv extra_lib "-openmp" #setenv extra_lib "-lrdmacm -libumad -lopa -lmpl -lrt -lpthread -libverbs -ldl" #setenv extra_lib "-lrdmacm -libumad " @@ -46,10 +46,8 @@ setenv extra_lib ##> Intel fortran compiler...................................................... setenv compiler intel setenv compiler_ext ifort - setenv myFC /home/563/jds563/.local/bin/mpif90 - setenv myCC /home/563/jds563/.local/bin/mpicc - #setenv myFC ifort - #setenv myCC icc + setenv myFC mpif90 + setenv myCC mpicc setenv myLINK_FLAG "-i-static" setenv myFFLAGS "-fixed -132 -O3 -override-limits -fno-alias -mp1 -fp-model precise" setenv myFRFLAGS "-free -O3 -fno-alias -mp1 -fp-model precise" @@ -77,9 +75,9 @@ setenv extra_lib setenv myFC mpif90 #gfortran setenv myCC gcc setenv myLINK_FLAG "" - setenv myFFLAGS "-ffixed-form -ffixed-line-length-132 -O3 -funroll-loops -finit-character=32" - setenv myFRFLAGS "-ffree-form -ffree-line-length-none -O3 -funroll-loops -finit-character=32" - setenv myCFLAGS "-O2" + setenv myFFLAGS "-ffixed-form -ffixed-line-length-132 -g -O2 -fbacktrace -funroll-loops -finit-character=32" + setenv myFRFLAGS "-ffree-form -ffree-line-length-none -g -O2 -fbacktrace -funroll-loops -finit-character=32" + setenv myCFLAGS "-g -O2 -fbacktrace" setenv extra_lib setenv extra_lib "$extra_lib -lgomp" breaksw @@ -90,15 +88,14 @@ setenv extra_lib breaksw endsw - + #=============================================================================== #> generate library locations setenv M3LIB ${lib_basedir}/${system}/${compiler} if ( ! -d $M3LIB ) mkdir -p $M3LIB - ## setenv MPI_INC $M3LIB/mpich/include - setenv MPI_INC ${HOME}/.local/include + setenv MPI_INC /usr/lib/${system}-linux-gnu/openmpi/include #> set executable id - setenv EXEC_ID ${bld_os}_${system}${compiler} + setenv EXEC_ID ${bld_os}_${system}${compiler_ext} # unset echo diff --git a/scripts/icon/bldit.icon b/scripts/icon/bldit.icon index 761a8a2..b36568f 100755 --- a/scripts/icon/bldit.icon +++ b/scripts/icon/bldit.icon @@ -50,9 +50,9 @@ #> user choices: base working directory set Base = $cwd - set APPL = D502a +# set APPL = D502a_cb05tucl_ae6_aq + set APPL = CH4only set CFG = cfg.$APPL - set MODEL = ICON_${APPL}_$EXEC_ID #set Local # do NOT copy the source files into the BLD directory - # comment out to copy the source files (default if not set) @@ -79,17 +79,26 @@ set ModCommon = common set ModType = profile -#set ModType = m3conc +# set ModType = m3conc #set ModType = tracer - set ModMech = prof_data/cb05_ae6_aq + set ModMech = prof_data/cb05tucl_ae6_aq_RN2 +# set ModMech = prof_data/CO2only + set ModMech = prof_data/CH4only +# set ModMech = prof_data/cb05tucl_ae6_aq_CO2 +# set ModMech = prof_data/cb05tucl_ae6_aq #set ModMech = prof_data/saprc99_ae6_aq #set ModMech = prof_data/saprc07t_ae6_aq #> user choices: mechanism #set Mechanism = cb05cl_ae5_aq #set Mechanism = cb05tucl_ae5_aq - set Mechanism = cb05tucl_ae6_aq +#set Mechanism = cb05tucl_ae6_aq_RN2 +# set Mechanism = CO2only + set Mechanism = CH4only +#set Mechanism = cb05tucl_ae6_aq_CO2 +#set Mechanism = cb05tucl_ae6_aq + #set Mechanism = cb05tump_ae6_aq #set Mechanism = saprc99_ae5_aq #set Mechanism = saprc99_ae6_aq @@ -104,6 +113,8 @@ set Bld = $Base/BLD_${APPL} + set MODEL = ICON_${APPL}_${EXEC_ID}_${ModType}_${Mechanism} + #> Set full path of Fortran 90 compiler set FC = ${myFC} set FP = $FC @@ -112,11 +123,11 @@ set Blder = $M3LIB/bldmake #> Set location of libraries/include files - set IOAPI = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lioapi" - set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext}" + set IOAPI = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID} -lioapi" + set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID}" # set NETCDF = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lnetcdf" - set NETCDF = "/home/563/jds563/.local/lib -lnetcdf -lnetcdff" + set NETCDF = "`nf-config --flibs`" set PARMOD = "." set STENEX = "." @@ -127,7 +138,7 @@ set F90_FLAGS = "${myFRFLAGS} -I ${IOAPIMOD} -I ${PARMOD} -I ${STENEX} -I." set CPP_FLAGS = "" set C_FLAGS = "${myCFLAGS} -DFLDMN -I ${MPI_INC}" - set LINK_FLAGS = "${myLINK_FLAG} -lpthread -openmp" + set LINK_FLAGS = "${myLINK_FLAG} -fopenmp" #:#:#:#:#:#:#:#:#:#:#:# End of User Input Section :#:#:#:#:#:#:#:#:#:#:#:#:# @@ -152,7 +163,7 @@ set STX = set LIB4 = "-L${IOAPI}" - set LIB5 = "-L${NETCDF}" + set LIB5 = "${NETCDF}" set LIBS = "$LIB1 $LIB2 $LIB3 $LIB4 $LIB5 ${extra_lib}" source $Base/relinc.icon diff --git a/scripts/jproc/bldit.jproc b/scripts/jproc/bldit.jproc index 90dbaf9..6a95f2e 100755 --- a/scripts/jproc/bldit.jproc +++ b/scripts/jproc/bldit.jproc @@ -50,7 +50,8 @@ #> user choices: base working directory set Base = $cwd - set APPL = D502a + #set APPL = D502a + set APPL = CH4only set CFG = cfg.$APPL set MODEL = JPROC_${APPL}_$EXEC_ID @@ -81,7 +82,8 @@ #> user choices: mechanism #set Mechanism = cb05cl_ae5_aq #set Mechanism = cb05tucl_ae5_aq - set Mechanism = cb05tucl_ae6_aq +# set Mechanism = cb05tucl_ae6_aq + set Mechanism = CH4only #set Mechanism = cb05tump_ae6_aq #set Mechanism = saprc99_ae5_aq #set Mechanism = saprc99_ae6_aq @@ -103,18 +105,18 @@ set Blder = $M3LIB/bldmake #> Set location of libraries/include files - set LIOAPI = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lioapi" - set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext}" + set LIOAPI = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID} -lioapi" + set IOAPIMOD = "${M3HOME}/lib/ioapi-3.1/${EXEC_ID}" # set NETCDF = "${M3HOME}/lib/netcdf/lib -lnetcdf -L${M3HOME}/lib/netcdf/lib/Intel -lnetcdff -L${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lnetcdf" - set NETCDF = "${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} -lnetcdf" + set NETCDF = "`nf-config --flibs`" #> Set compiler flags set F_FLAGS = "${myFFLAGS} -I${IOAPIMOD} -I." set F90_FLAGS = "${myFRFLAGS} -I${IOAPIMOD} -I." set CPP_FLAGS = "" set C_FLAGS = "${myCFLAGS} -DFLDMN" - set LINK_FLAGS = "${myLINK_FLAG} -lpthread -openmp" + set LINK_FLAGS = "${myLINK_FLAG} -lpthread -fopenmp" #:#:#:#:#:#:#:#:#:#:#:# End of User Input Section :#:#:#:#:#:#:#:#:#:#:#:#:# @@ -132,7 +134,7 @@ #:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:# set LIB1 = "-L${LIOAPI}" - set LIB2 = "-L${NETCDF}" + set LIB2 = "${NETCDF}" set LIBS = "$LIB1 $LIB2" source $Base/relinc.jproc diff --git a/scripts/mcip/src/Makefile b/scripts/mcip/src/Makefile index fdbc9dd..094c8d2 100644 --- a/scripts/mcip/src/Makefile +++ b/scripts/mcip/src/Makefile @@ -21,6 +21,7 @@ MODEL = mcip.exe NETCDF = /home/563/jds563/.local +NETCDF = /apps/netcdf/4.7.1 M3LIB=/home/563/jds563/programs/CMAQ IOAPI_ROOT = $(M3LIB)/ioapi-3.1 PVM = /home/563/jds563/programs/pvm3 @@ -45,18 +46,14 @@ PVM = /home/563/jds563/programs/pvm3 # -L$(PVM)/lib -lpvm3 #...Intel Fortran -FC = ifort -FFLAGS = -g -O0 -check all -C -traceback -FR -I$(NETCDF)/include \ - -I$(IOAPI_ROOT)/Linux2_x86_64ifort -FFLAGS = -FR -O3 -traceback -I$(NETCDF)/include -I$(IOAPI_ROOT)/Linux2_x86_64ifort -openmp +#FC = mpif90 +#FFLAGS = -g -O3 -I${ROOT}/ioapi-3.1/${BIN} $(nf-config --fflags) # LIBS = -L$(IOAPI_ROOT)/Linux2_x86_64ifort -lioapi \ # -L$(NETCDF)/lib -lnetcdf -lnetcdff \ # -L$(PVM)/lib/LINUX64 -lpvm3 \ # -limf -LIBS = -L$(IOAPI_ROOT)/Linux2_x86_64ifort -lioapi -lnetcdf \ - -L$(NETCDF)/lib -lnetcdf -lnetcdff \ - -L$(PVM)/lib/LINUX64 -lpvm3 \ - -limf +#LIBS = -L${ROOT}/ioapi-3.1/${BIN} -lioapi -lnetcdf -lnetcdff -fopenmp +## -L$(PVM)/lib/LINUX64 -lpvm3 \ DEFS = diff --git a/scripts/mcip/src/rdwrfem.f90 b/scripts/mcip/src/rdwrfem.f90 index d19a583..5909940 100644 --- a/scripts/mcip/src/rdwrfem.f90 +++ b/scripts/mcip/src/rdwrfem.f90 @@ -1500,8 +1500,16 @@ SUBROUTINE rdwrfem (mcip_now) frc_urb(:,ny) = frc_urb(:,nym) WRITE (*,f6000) 'FRC_URB ', frc_urb(lprt_metx, lprt_mety), 'fraction' ELSE - WRITE (*,f9400) TRIM(pname), 'FRC_URB', TRIM(nf90_strerror(rcode)) - CALL graceful_stop (pname) + CALL get_var_2d_real_cdf (cdfid, 'FRC_URB2D', dum2d, it, rcode) + IF ( rcode == nf90_noerr ) THEN + frc_urb(1:nxm,1:nym) = dum2d(:,:) + frc_urb(nx,:) = frc_urb(nxm,:) + frc_urb(:,ny) = frc_urb(:,nym) + WRITE (*,f6000) 'FRC_URB ', frc_urb(lprt_metx, lprt_mety), 'fraction' + ELSE + WRITE (*,f9400) TRIM(pname), 'FRC_URB', TRIM(nf90_strerror(rcode)) + CALL graceful_stop (pname) + ENDIF ENDIF ENDIF IF ( lpv > 0 ) THEN diff --git a/scripts/mcip/src/setup.f90 b/scripts/mcip/src/setup.f90 index b466066..2485be8 100644 --- a/scripts/mcip/src/setup.f90 +++ b/scripts/mcip/src/setup.f90 @@ -128,12 +128,13 @@ SUBROUTINE setup (ctmlays) WRITE (*,f9300) TRIM(pname), 'TITLE', TRIM(nf90_strerror(rcode)) CALL graceful_stop (pname) ENDIF - IF ( wrfversion(18:19) == "V3" ) THEN - met_iversion = 2 ! NCAR only supports mass core in WRFv3 and beyond - ELSE - WRITE (*,f9400) TRIM(pname), TRIM(wrfversion) - CALL graceful_stop (pname) - ENDIF + met_iversion = 2 ! NCAR only supports mass core in WRFv3 and beyond + ! IF ( wrfversion(18:19) == "V3" ) THEN + ! met_iversion = 2 ! NCAR only supports mass core in WRFv3 and beyond + ! ELSE + ! WRITE (*,f9400) TRIM(pname), TRIM(wrfversion) + ! CALL graceful_stop (pname) + ! ENDIF ENDIF rcode = nf90_get_att (cdfid, nf90_global, 'GRIDTYPE', gridtype) diff --git a/scripts/pario/bldit.pario b/scripts/pario/bldit.pario index b7085e5..a5a8386 100755 --- a/scripts/pario/bldit.pario +++ b/scripts/pario/bldit.pario @@ -55,7 +55,7 @@ set MPI_INC = ${M3HOME}/lib/mpich/include set IOAPIEXT = ${M3HOME}/lib/ioapi-3.1/ioapi/fixed_src - set IOAPIMOD = ${M3HOME}/lib/ioapi-3.1/Linux2_${system}${compiler_ext} + set IOAPIMOD = ${M3HOME}/lib/ioapi-3.1/${BIN} #> Set full path of Fortran 90 compiler set FC = ${myFC} diff --git a/scripts/procan/bldit.pacp b/scripts/procan/bldit.pacp index fbe31a5..025b8e0 100755 --- a/scripts/procan/bldit.pacp +++ b/scripts/procan/bldit.pacp @@ -104,10 +104,10 @@ set Blder = $M3LIB/bldmake #> Set location of libraries/include files - set IOAPI = "${M3LIB}/ioapi_3.1/Linux2_${system}${compiler_ext} -lioapi" - set IOAPIMOD = ${M3LIB}/ioapi_3.1/Linux2_${system}${compiler_ext} + set IOAPI = "${M3LIB}/ioapi_3.1/${EXEC_ID} -lioapi" + set IOAPIMOD = ${M3LIB}/ioapi_3.1/${EXEC_ID} - set NETCDF = "${M3LIB}/netcdf/lib -lnetcdf" + set NETCDF = "`nf-config --flibs`" #> Set compiler flags set F_FLAGS = "${myFFLAGS} -I ${IOAPIMOD} -I." @@ -132,7 +132,7 @@ #:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:# set LIB1 = "-L${IOAPI}" - set LIB2 = "-L${NETCDF}" + set LIB2 = "${NETCDF}" set LIBS = "$LIB1 $LIB2" source $Base/relinc.pacp